diff --git a/sorc/ncep_post.fd/CMakeLists.txt b/sorc/ncep_post.fd/CMakeLists.txt index 5fba419fc..0855a7788 100644 --- a/sorc/ncep_post.fd/CMakeLists.txt +++ b/sorc/ncep_post.fd/CMakeLists.txt @@ -150,14 +150,11 @@ list(APPEND EXE_SRC GETNEMSNDSCATTER.f GFSPOSTSIG.F INITPOST.F - INITPOST_GFS_NEMS.f INITPOST_GFS_NEMS_MPIIO.f INITPOST_GFS_NETCDF.f INITPOST_GFS_NETCDF_PARA.f INITPOST_NEMS.f - INITPOST_NEMS_MPIIO.f INITPOST_NETCDF.f - INITPOST_NMM.f WRFPOST.f getIVariableN.f getVariable.f @@ -224,8 +221,8 @@ if(BUILD_POSTEXEC) add_executable(${EXENAME} ${EXE_SRC}) target_link_libraries(${EXENAME} PRIVATE ${LIBNAME} - w3nco::w3nco_4 nemsio::nemsio + w3nco::w3nco_4 sp::sp_4 sfcio::sfcio sigio::sigio) diff --git a/sorc/ncep_post.fd/INITPOST_GFS_NEMS.f b/sorc/ncep_post.fd/INITPOST_GFS_NEMS.f deleted file mode 100644 index 2f04cfb7e..000000000 --- a/sorc/ncep_post.fd/INITPOST_GFS_NEMS.f +++ /dev/null @@ -1,3264 +0,0 @@ -!> @file -! . . . -!> SUBPROGRAM: INITPOST INITIALIZE POST FOR RUN -!! PRGRMMR: Hui-Ya Chuang DATE: 2007-03-01 -!! -!! ABSTRACT: THIS ROUTINE INITIALIZES CONSTANTS AND -!! VARIABLES AT THE START OF GFS MODEL OR POST -!! PROCESSOR RUN. -!! -!! REVISION HISTORY -!! 2011-02-07 Jun Wang add grib2 option -!! 2011-12-14 Sarah Lu add aer option -!! 2012-01-07 Sarah Lu compute air density -!! 2012-12-22 Sarah Lu add aerosol zerout option -!! 2015-03-16 S. Moorthi adding gocart_on option -!! 2015-03-18 S. Moorthi Optimization including threading -!! 2015-08-17 S. Moorthi Add TKE for NEMS/GSM -!! 2021-03-11 Bo Cui change local arrays to dimension (im,jsta:jend) -!! -!! USAGE: CALL INIT -!! INPUT ARGUMENT LIST: -!! NONE -!! -!! OUTPUT ARGUMENT LIST: -!! NONE -!! -!! OUTPUT FILES: -!! NONE -!! -!! SUBPROGRAMS CALLED: -!! UTILITIES: -!! NONE -!! LIBRARY: -!! COMMON - CTLBLK -!! LOOKUP -!! SOILDEPTH -!! -!! -!! ATTRIBUTES: -!! LANGUAGE: FORTRAN -!! MACHINE : CRAY C-90 -!! - SUBROUTINE INITPOST_GFS_NEMS(NREC,iostatusFlux,iostatusD3D, & - iostatusAER,nfile,ffile,rfile) -! SUBROUTINE INITPOST_GFS_NEMS(NREC,iostatusFlux,iostatusD3D,nfile,ffile) - - - use vrbls4d, only: dust, SALT, SUSO, SOOT, WASO - use vrbls3d, only: t, q, uh, vh, pmid, pint, alpint, dpres, zint, zmid, o3, & - qqr, qqs, cwm, qqi, qqw, omga, rhomid, q2, cfr, rlwtt, rswtt, tcucn, & - tcucns, train, el_pbl, exch_h, vdifftt, vdiffmois, dconvmois, nradtt, & - o3vdiff, o3prod, o3tndy, mwpv, unknown, vdiffzacce, zgdrag,cnvctummixing, & - vdiffmacce, mgdrag, cnvctvmmixing, ncnvctcfrac, cnvctumflx, cnvctdmflx, & - cnvctzgdrag, sconvmois, cnvctmgdrag, cnvctdetmflx, duwt, duem, dusd, dudp - use vrbls2d, only: f, pd, fis, pblh, ustar, z0, ths, qs, twbs, qwbs, avgcprate, & - cprate, avgprec, prec, lspa, sno, si, cldefi, th10, q10, tshltr, pshltr, & - tshltr, albase, avgalbedo, avgtcdc, czen, czmean, mxsnal, radot, sigt4, & - cfrach, cfracl, cfracm, avgcfrach, qshltr, avgcfracl, avgcfracm, cnvcfr, & - islope, cmc, grnflx, vegfrc, acfrcv, ncfrcv, acfrst, ncfrst, ssroff, & - bgroff, rlwin, rlwtoa, cldwork, alwin, alwout, alwtoa, rswin, rswinc, & - rswout, aswin, auvbin, auvbinc, aswout, aswtoa, sfcshx, sfclhx, subshx, & - snopcx, sfcux, sfcvx, sfcuvx, gtaux, gtauy, potevp, u10, v10, smstav, & - smstot, ivgtyp, isltyp, sfcevp, sfcexc, acsnow, acsnom, sst, thz0, qz0, & - uz0, vz0, ptop, htop, pbot, hbot, ptopl, pbotl, ttopl, ptopm, pbotm, ttopm, & - ptoph, pboth, pblcfr, ttoph, runoff, maxtshltr, mintshltr, maxrhshltr, & - minrhshltr, dzice, smcwlt, suntime, fieldcapa, htopd, hbotd, htops, hbots, & - cuppt, dusmass, ducmass, dusmass25, ducmass25, aswintoa, & - u10h,v10h - use soil, only: sldpth, sh2o, smc, stc - use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice -! use kinds, only: i_llong - use nemsio_module, only: nemsio_gfile, nemsio_getfilehead, nemsio_getheadvar, nemsio_close - use physcons_post, only: grav => con_g, fv => con_fvirt, rgas => con_rd, & - eps => con_eps, epsm1 => con_epsm1 - use params_mod, only: erad, dtr, tfrz, h1, d608, rd, p1000, capa - use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, qs0, sqs, sthe, & - ttblq, rdpq, rdtheq, stheq, the0q, the0 - use ctlblk_mod, only: me, mpi_comm_comp, icnt, idsp, jsta, jend, ihrst, idat, sdat, ifhr, & - ifmin, filename, tprec, tclod, trdlw, trdsw, tsrfc, tmaxmin, td3d, restrt, sdat, & - jend_m, imin, imp_physics, dt, spval, pdtop, pt, qmin, nbin_du, nphs, dtq2, ardlw,& - ardsw, asrfc, avrain, avcnvc, theat, gdsdegr, spl, lsm, alsl, im, jm, im_jm, lm, & - jsta_2l, jend_2u, nsoil, lp1, icu_physics, ivegsrc, novegtype, nbin_ss, nbin_bc, & - nbin_oc, nbin_su, gocart_on, pt_tbl, hyb_sigp - use gridspec_mod, only: maptype, gridtype, latstart, latlast, lonstart, lonlast, cenlon, & - dxval, dyval, truelat2, truelat1, psmapf, cenlat - use upp_physics, only: fpvsnew -! use wrf_io_flags_mod, only: ! Do we need this? -!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - implicit none -! - type(nemsio_gfile),intent(inout) :: nfile,ffile,rfile -! -! INCLUDE/SET PARAMETERS. -! - INCLUDE "mpif.h" - -! integer,parameter:: MAXPTS=1000000 ! max im*jm points -! -! real,parameter:: con_g =9.80665e+0! gravity -! real,parameter:: con_rv =4.6150e+2 ! gas constant H2O -! real,parameter:: con_rd =2.8705e+2 ! gas constant air -! real,parameter:: con_fvirt =con_rv/con_rd-1. -! real,parameter:: con_eps =con_rd/con_rv -! real,parameter:: con_epsm1 =con_rd/con_rv-1 -! -! This version of INITPOST shows how to initialize, open, read from, and -! close a NetCDF dataset. In order to change it to read an internal (binary) -! dataset, do a global replacement of _ncd_ with _int_. - - real, parameter :: gravi = 1.0/grav - integer,intent(in) :: NREC,iostatusFlux,iostatusD3D,iostatusAER - character(len=20) :: VarName, VcoordName - integer :: Status - character startdate*19,SysDepInfo*80,cgar*1 - character startdate2(19)*4 -! -! NOTE: SOME INTEGER VARIABLES ARE READ INTO DUMMY ( A REAL ). THIS IS OK -! AS LONG AS REALS AND INTEGERS ARE THE SAME SIZE. -! -! ALSO, EXTRACT IS CALLED WITH DUMMY ( A REAL ) EVEN WHEN THE NUMBERS ARE -! INTEGERS - THIS IS OK AS LONG AS INTEGERS AND REALS ARE THE SAME SIZE. - LOGICAL RUNB,SINGLRST,SUBPOST,NEST,HYDRO,IOOMG,IOALL - logical, parameter :: debugprint = .false., zerout = .false. -! logical, parameter :: debugprint = .true., zerout = .false. - CHARACTER*32 LABEL - CHARACTER*40 CONTRL,FILALL,FILMST,FILTMP,FILTKE,FILUNV,FILCLD,FILRAD,FILSFC - CHARACTER*4 RESTHR - CHARACTER FNAME*255,ENVAR*50 - INTEGER IDATE(8),JDATE(8),JPDS(200),JGDS(200),KPDS(200),KGDS(200),IGDS(18) -! LOGICAL*1 LB(IM,JM) -! -! INCLUDE COMMON BLOCKS. -! -! DECLARE VARIABLES. -! -! REAL fhour - integer nfhour ! forecast hour from nems io file - REAL RINC(5) - - REAL DUMMY(IM,JM), DUMMY2(IM,JM) - real, allocatable :: fi(:,:,:) -!jw - integer ii,jj,js,je,iyear,imn,iday,itmp,ioutcount,istatus, & - I,J,L,ll,k,kf,irtn,igdout,n,Index,nframe, & - impf,jmpf,nframed2,iunitd3d,ierr,idum,iret - real TSTART,TLMH,TSPH,ES,FACT,soilayert,soilayerb,zhour,dum, & - tvll,pmll,tv - - character*8, allocatable :: recname(:) - character*16,allocatable :: reclevtyp(:) - integer, allocatable :: reclev(:) - real, allocatable :: glat1d(:), glon1d(:), qstl(:) - real, allocatable :: wrk1(:,:), wrk2(:,:) - real, allocatable :: p2d(:,:), t2d(:,:), q2d(:,:), & - qs2d(:,:), cw2d(:,:), cfr2d(:,:) - real(kind=4),allocatable :: vcoord4(:,:,:) - real, dimension(lm+1) :: ak5, bk5 - real*8, allocatable :: pm2d(:,:), pi2d(:,:) - - real buf(im,jsta_2l:jend_2u) - -! real buf(im,jsta_2l:jend_2u),bufsoil(im,nsoil,jsta_2l:jend_2u) & -! ,buf3d(im,jsta_2l:jend_2u,lm),buf3d2(im,lp1,jsta_2l:jend_2u) - - real LAT, isa, jsa -! REAL, PARAMETER :: QMIN = 1.E-15 - -! DATA BLANK/' '/ -! -!*********************************************************************** -! START INIT HERE. -! - WRITE(6,*)'INITPOST: ENTER INITPOST_GFS_NEMS' - WRITE(6,*)'me=',me,'LMV=',size(LMV,1),size(LMV,2),'LMH=', & - size(LMH,1),size(LMH,2),'jsta_2l=',jsta_2l,'jend_2u=', & - jend_2u,'im=',im -! - isa = im / 2 - jsa = (jsta+jend) / 2 - -!$omp parallel do private(i,j) - do j = jsta_2l, jend_2u - do i=1,im - buf(i,j) = spval - enddo - enddo -! -! STEP 1. READ MODEL OUTPUT FILE -! -! -!*** -! -! LMH and LMV always = LM for sigma-type vert coord - -!$omp parallel do private(i,j) - do j = jsta_2l, jend_2u - do i = 1, im - LMV(i,j) = lm - LMH(i,j) = lm - end do - end do - -! HTM VTM all 1 for sigma-type vert coord - -!$omp parallel do private(i,j,l) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - HTM (i,j,l) = 1.0 - VTM (i,j,l) = 1.0 - end do - end do - end do -! -! how do I get the filename? -! fileName = '/ptmp/wx20mb/wrfout_01_030500' -! DateStr = '2002-03-05_18:00:00' -! how do I get the filename? -! call ext_int_ioinit(SysDepInfo,Status) -! print*,'called ioinit', Status -! call ext_int_open_for_read( trim(fileName), 0, 0, " ", -! & DataHandle, Status) -! print*,'called open for read', Status -! if ( Status /= 0 ) then -! print*,'error opening ',fileName, ' Status = ', Status ; stop -! endif -! get date/time info -! this routine will get the next time from the file, not using it -! print *,'DateStr before calling ext_int_get_next_time=',DateStr -! call ext_int_get_next_time(DataHandle, DateStr, Status) -! print *,'DateStri,Status,DataHandle = ',DateStr,Status,DataHandle - -! The end j row is going to be jend_2u for all variables except for V. - - JS = JSTA_2L - JE = JEND_2U - -! get start date - if (me == 0)then - print*,'nrec=',nrec - allocate(recname(nrec),reclevtyp(nrec),reclev(nrec)) - allocate(glat1d(im*jm),glon1d(im*jm)) - allocate(vcoord4(lm+1,3,2)) - call nemsio_getfilehead(nfile,iret=iret & - ,idate=idate(1:7),nfhour=nfhour,recname=recname & - ,reclevtyp=reclevtyp,reclev=reclev,lat=glat1d & - ,lon=glon1d,nframe=nframe,vcoord=vcoord4) - if(iret/=0)print*,'error getting idate,nfhour' - print *,'latstar1=',glat1d(1),glat1d(im*jm) -! print *,'printing an inventory of GFS nemsio file' -! do i=1,nrec -! print *,'recname=',(trim(recname(i))) -! print *,'reclevtyp=',(trim(reclevtyp(i))) -! print *,'reclev=',(reclev(i)) -! end do -! deallocate (recname,reclevtyp,reclev) - -! call nemsio_getfilehead(ffile,nrec=idum) -! print*,'nrec for flux file = ',idum -! allocate(recname(idum),reclevtyp(idum),reclev(idum)) -! call nemsio_getfilehead(ffile,iret=iret, & -! recname=recname,reclevtyp=reclevtyp,reclev=reclev) -! do i=1,idum -! print *,'recname=',(trim(recname(i))) -! print *,'reclevtyp=',(trim(reclevtyp(i))) -! print *,'reclev=',(reclev(i)) -! end do - -!$omp parallel do private(i,j) - do j=1,jm - do i=1,im - dummy(i,j) = glat1d((j-1)*im+i) - dummy2(i,j) = glon1d((j-1)*im+i) - end do - end do -! - if (hyb_sigp) then - do l=1,lm+1 - ak5(l) = vcoord4(l,1,1) - bk5(l) = vcoord4(l,2,1) - enddo - endif -! - deallocate(recname,reclevtyp,reclev,glat1d,glon1d,vcoord4) -! can't get idate and fhour, specify them for now -! idate(4)=2006 -! idate(2)=9 -! idate(3)=16 -! idate(1)=0 -! fhour=6.0 - print*,'idate before broadcast = ',(idate(i),i=1,7) - end if - call mpi_bcast(idate(1), 7, MPI_INTEGER, 0, mpi_comm_comp, iret) - call mpi_bcast(nfhour, 1, MPI_INTEGER, 0, mpi_comm_comp, iret) - call mpi_bcast(nframe, 1, MPI_INTEGER, 0, mpi_comm_comp, iret) - print*,'idate after broadcast = ',(idate(i),i=1,4) - print*,'nfhour = ',nfhour - - if (hyb_sigp) then - call mpi_bcast(ak5, lm+1, MPI_REAL, 0, mpi_comm_comp, iret) - call mpi_bcast(bk5, lm+1, MPI_REAL, 0, mpi_comm_comp, iret) - endif - if (me == 0) print *,' ak5=',ak5 - if (me == 0) print *,' bk5=',bk5 - -! sample print point - ii = im/2 - jj = jm/2 - call mpi_scatterv(dummy(1,1),icnt,idsp,mpi_real & - ,gdlat(1,jsta),icnt(me),mpi_real,0,MPI_COMM_COMP,ierr) - call mpi_scatterv(dummy2(1,1),icnt,idsp,mpi_real & - ,gdlon(1,jsta),icnt(me),mpi_real,0,MPI_COMM_COMP,ierr) - - print *,'before call EXCH,mype=',me,'max(gdlat)=',maxval(gdlat), & - 'max(gdlon)=', maxval(gdlon) - CALL EXCH(gdlat(1,JSTA_2L)) - print *,'after call EXCH,mype=',me - -!$omp parallel do private(i,j) - do j = jsta, jend_m - do i = 1, im-1 - DX (i,j) = ERAD*COS(GDLAT(I,J)*DTR) *(GDLON(I+1,J)-GDLON(I,J))*DTR - DY (i,j) = ERAD*(GDLAT(I,J)-GDLAT(I,J+1))*DTR ! like A*DPH -! F(I,J)=1.454441e-4*sin(gdlat(i,j)*DTR) ! 2*omeg*sin(phi) -! if (i == ii .and. j == jj) print*,'sample LATLON, DY, DY=' & -! ,i,j,GDLAT(I,J),GDLON(I,J),DX(I,J),DY(I,J) - end do - end do - -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - F(I,J) = 1.454441e-4*sin(gdlat(i,j)*DTR) ! 2*omeg*sin(phi) - end do - end do - - impf = im - jmpf = jm - print*,'impf,jmpf,nframe= ',impf,jmpf,nframe - -!MEB not sure how to get these - ! waiting to read in lat lon from GFS soon -! varname='GLAT' -! call retrieve_index(index,VarName,varname_all,nrecs,iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! GDLAT=SPVAL -! else -! this_offset=file_offset(index+1)+(jsta_2l-1)*4*im -! this_length=im*(jend_2u-jsta_2l+1) -! call mpi_file_read_at(iunit,this_offset -! + ,buf,this_length,mpi_real4 -! + , mpi_status_ignore, ierr) -! if (ierr /= 0) then -! print*,"Error reading ", VarName,"Assigned missing values" -! GDLAT=SPVAL -! else -! do j = jsta_2l, jend_2u -! do i = 1, im -! F(I,J)=1.454441e-4*sin(buf(I,J)) ! 2*omeg*sin(phi) -! GDLAT(I,J)=buf(I,J)*RTD - -! enddo -! enddo -! end if -! end if - -! varname='GLON' -! call retrieve_index(index,VarName,varname_all,nrecs,iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! GDLON=SPVAL -! else -! this_offset=file_offset(index+1)+(jsta_2l-1)*4*im -! this_length=im*(jend_2u-jsta_2l+1) -! call mpi_file_read_at(iunit,this_offset -! + ,buf,this_length,mpi_real4 -! + , mpi_status_ignore, ierr) -! if (ierr /= 0) then -! print*,"Error reading ", VarName,"Assigned missing values" -! GDLON=SPVAL -! else -! do j = jsta_2l, jend_2u -! do i = 1, im -! GDLON(I,J)=buf(I,J)*RTD -! if(i == 409.and.j == 835)print*,'GDLAT GDLON in INITPOST=' -! + ,i,j,GDLAT(I,J),GDLON(I,J) -! enddo -! enddo -! end if -! end if - -! if(jsta<=594.and.jend>=594)print*,'gdlon(120,594)= ', -! + gdlon(120,594) - - -! iyear=idate(4)+2000 ! older gfsio only has 2 digit year - iyear = idate(1) - imn = idate(2) ! ask Jun - iday = idate(3) ! ask Jun - ihrst = idate(4) - imin = idate(5) - jdate = 0 - idate = 0 -! -! read(startdate,15)iyear,imn,iday,ihrst,imin - 15 format(i4,1x,i2,1x,i2,1x,i2,1x,i2) - print*,'start yr mo day hr min =',iyear,imn,iday,ihrst,imin - print*,'processing yr mo day hr min=' & - ,idat(3),idat(1),idat(2),idat(4),idat(5) -! - idate(1) = iyear - idate(2) = imn - idate(3) = iday - idate(5) = ihrst - idate(6) = imin - SDAT(1) = imn - SDAT(2) = iday - SDAT(3) = iyear - jdate(1) = idat(3) - jdate(2) = idat(1) - jdate(3) = idat(2) - jdate(5) = idat(4) - jdate(6) = idat(5) -! - print *,' idate=',idate - print *,' jdate=',jdate -! CALL W3DIFDAT(JDATE,IDATE,2,RINC) -! ifhr=nint(rinc(2)) -! - CALL W3DIFDAT(JDATE,IDATE,0,RINC) -! - print *,' rinc=',rinc - ifhr = nint(rinc(2)+rinc(1)*24.) - print *,' ifhr=',ifhr - ifmin = nint(rinc(3)) -! if(ifhr /= nint(fhour))print*,'find wrong Grib file';stop - print*,' in INITPOST ifhr ifmin fileName=',ifhr,ifmin,fileName - -! GFS has the same accumulation bucket for precipitation and fluxes and it is written to header -! the header has the start hour information so post uses it to recontruct bucket - if(me==0)then - call nemsio_getheadvar(ffile,'zhour',zhour,iret=iret) - if(iret==0)then - tprec = 1.0*ifhr-zhour - tclod = tprec - trdlw = tprec - trdsw = tprec - tsrfc = tprec - tmaxmin = tprec - td3d = tprec - print*,'tprec from flux file header= ',tprec - else - print*,'Error reading accumulation bucket from flux file', & - 'header - will try to read from env variable FHZER' - CALL GETENV('FHZER',ENVAR) - read(ENVAR, '(I2)')idum - tprec = idum*1.0 - tclod = tprec - trdlw = tprec - trdsw = tprec - tsrfc = tprec - tmaxmin = tprec - td3d = tprec - print*,'TPREC from FHZER= ',tprec - end if - end if - - call mpi_bcast(tprec, 1,MPI_REAL,0,mpi_comm_comp,iret) - call mpi_bcast(tclod, 1,MPI_REAL,0,mpi_comm_comp,iret) - call mpi_bcast(trdlw, 1,MPI_REAL,0,mpi_comm_comp,iret) - call mpi_bcast(trdsw, 1,MPI_REAL,0,mpi_comm_comp,iret) - call mpi_bcast(tsrfc, 1,MPI_REAL,0,mpi_comm_comp,iret) - call mpi_bcast(tmaxmin,1,MPI_REAL,0,mpi_comm_comp,iret) - call mpi_bcast(td3d, 1,MPI_REAL,0,mpi_comm_comp,iret) - -! Getting tstart - tstart=0. -! VarName='TSTART' -! call retrieve_index(index,VarName,varname_all,nrecs,iret) -! if (iret /= 0) then -! print*,VarName," not found in file" -! else -! call mpi_file_read_at(iunit,file_offset(index)+5*4 -! + ,garb,1,mpi_real4 -! + , mpi_status_ignore, ierr) -! if (ierr /= 0) then -! print*,"Error reading ", VarName," using MPIIO" -! else -! print*,VarName, ' from MPIIO READ= ',garb -! tstart=garb -! end if -! end if - print*,'tstart= ',tstart - -! Getiing restart - - RESTRT=.TRUE. ! set RESTRT as default -! call ext_int_get_dom_ti_integer(DataHandle,'RESTARTBIN',itmp -! + ,1,ioutcount,istatus) - -! IF(itmp < 1)THEN -! RESTRT=.FALSE. -! ELSE -! RESTRT=.TRUE. -! END IF - -! print*,'status for getting RESTARTBIN= ',istatus - -! print*,'Is this a restrt run? ',RESTRT - - IF(tstart > 1.0E-2)THEN - ifhr = ifhr+NINT(tstart) - rinc = 0 - idate = 0 - rinc(2) = -1.0*ifhr - call w3movdat(rinc,jdate,idate) - SDAT(1) = idate(2) - SDAT(2) = idate(3) - SDAT(3) = idate(1) - IHRST = idate(5) - print*,'new forecast hours for restrt run= ',ifhr - print*,'new start yr mo day hr min =',sdat(3),sdat(1) & - ,sdat(2),ihrst,imin - END IF - - imp_physics = 99 !set GFS mp physics to 99 for Zhao scheme - print*,'MP_PHYSICS= ',imp_physics - -! Initializes constants for Ferrier microphysics - if(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95)then - CALL MICROINIT(imp_physics) - end if - -! IVEGSRC=1 for IGBP, 0 for USGS, 2 for UMD - VarName='IVEGSRC' - if(me == 0)then - call nemsio_getheadvar(nfile,trim(VarName),IVEGSRC,iret) - if (iret /= 0) then - print*,VarName,' not found in file-Assigned 2 for UMD as default' - IVEGSRC=1 - end if - end if - call mpi_bcast(IVEGSRC,1,MPI_INTEGER,0,mpi_comm_comp,iret) - print*,'IVEGSRC= ',IVEGSRC - -! set novegtype based on vegetation classification - if(ivegsrc==2)then - novegtype=13 - else if(ivegsrc==1)then - novegtype=20 - else if(ivegsrc==0)then - novegtype=24 - end if - print*,'novegtype= ',novegtype - - VarName='CU_PHYSICS' - if(me == 0)then - call nemsio_getheadvar(nfile,trim(VarName),iCU_PHYSICS,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned 4 for SAS as default" - iCU_PHYSICS=4 - end if - end if - call mpi_bcast(iCU_PHYSICS,1,MPI_INTEGER,0,mpi_comm_comp,iret) - if (me == 0) print*,'CU_PHYSICS= ',iCU_PHYSICS -! waiting to retrieve lat lon infor from raw GFS output -! VarName='DX' - -! VarName='DY' - -! GFS does not need DT to compute accumulated fields, set it to one -! VarName='DT' - DT=1 -! GFS does not need truelat -! VarName='TRUELAT1' - -! VarName='TRUELAT2' - -! Specigy maptype=4 for Gaussian grid -! maptype=4 -! write(6,*) 'maptype is ', maptype -! HBM2 is most likely not in Grib message, set them to ones - HBM2=1.0 - -! try to get kgds from flux grib file and then convert to igds that is used by GRIBIT.f -! flux files are now nemsio files so comment the following lines out -! if(me == 0)then -! jpds=-1.0 -! jgds=-1.0 -! igds=0 -! call getgb(iunit,0,im_jm,0,jpds,jgds,kf & -! ,k,kpds,kgds,lb,dummy,ierr) -! if(ierr == 0)then -! call R63W72(KPDS,KGDS,JPDS,IGDS(1:18)) -! print*,'in INITPOST_GFS,IGDS for GFS= ',(IGDS(I),I=1,18) -! end if -! end if -! call mpi_bcast(igds(1),18,MPI_INTEGER,0,mpi_comm_comp,iret) -! print*,'IGDS for GFS= ',(IGDS(I),I=1,18) - -! Specigy grid type -! if(iostatusFlux==0)then - if(IGDS(4)/=0)then - maptype=IGDS(3) - else if((im/2+1)==jm)then - maptype=0 !latlon grid - else - maptype=4 ! default gaussian grid - end if - gridtype='A' - - if (me == 0) write(6,*) 'maptype and gridtype is ', maptype,gridtype - -! start retrieving data using gfsio, first land/sea mask - -! VarName='land' -! VcoordName='sfc' -! l=1 - -! if(me == 0)then -! call gfsio_readrecvw34(gfile,trim(VarName),trim(VcoordName) -! + ,l,dummy,iret=iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! dummy=spval -! else -! -! do j = 1, jm -! do i = 1, im -! dummy(I,J)=1.0 - dummy(I,J) ! convert Grib message to 2D -! if (j == jm/2 .and. mod(i,10) == 0) -! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) -! -! enddo -! enddo -! end if -! end if -! -! call mpi_scatterv(dummy,icnt,idsp,mpi_real -! + ,sm(1,jsta),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) -! if (iret /= 0)print*,'Error scattering array';stop - - VcoordName='sfc' ! surface fileds - l=1 - -! start retrieving data using getgb, first land/sea mask - VarName='land' - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,impf,jmpf,nframe,sm) - -! where(sm /= spval)sm=1.0-sm ! convert to sea mask -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (sm(i,j) /= spval) sm(i,j) = 1.0 - sm(i,j) - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',sm(isa,jsa) - - -! sea ice mask using getgb - - VarName='icec' - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,sice) - -! if(debugprint)print*,'sample ',VarName,' = ',sice(isa,jsa) - -! where(sice /=spval .and. sice >=1.0)sm=0.0 !sea ice has sea mask=0 -! GFS flux files have land points with non-zero sea ice, per Iredell, these -! points have sea ice changed to zero, i.e., trust land mask more than sea ice -! where(sm/=spval .and. sm==0.0)sice=0.0 !specify sea ice=0 at land - -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (sm(i,j) /= spval .and. sm(i,j) == 0.0) sice(i,j) = 0.0 - enddo - enddo - -! Terrain height * G using nemsio - VarName='hgt' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,fis) - -! where(fis /= spval)fis=fis*grav - -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (fis(i,j) /= spval) then - zint(i,j,lp1) = fis(i,j) - fis(i,j) = fis(i,j) * grav - - endif - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',fis(isa,jsa) - -! Surface pressure using nemsio - VarName='pres' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,pint(1,jsta_2l,lp1)) - -! if(debugprint)print*,'sample surface pressure = ',pint(isa,jsa,lp1 - -! -! vertical loop for Layer 3d fields -! -------------------------------- - VcoordName = 'mid layer' - - do l=1,lm - ll=lm-l+1 - -! model level T - print*,'start retrieving GFS T using nemsio' - VarName='tmp' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,t(1,jsta_2l,ll)) - -! if(debugprint)print*,'sample ',ll,VarName,' = ',ll,t(isa,jsa,ll) - -! model level q - VarName='spfh' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,q(1,jsta_2l,ll)) -! if(debugprint)print*,'sample ',ll,VarName,' = ',ll,q(isa,jsa,ll) - -! i model level u - VarName='ugrd' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,uh(1,jsta_2l,ll)) -! if(debugprint)print*,'sample ',ll,VarName,' = ',ll,uh(isa,jsa,ll) - -! model level v - VarName='vgrd' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,vh(1,jsta_2l,ll)) -! if(debugprint)print*,'sample ',ll,VarName,' = ',ll,vh(isa,jsa,ll) - -! model level pressure - if (.not. hyb_sigp) then - VarName='pres' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,pmid(1,jsta_2l,ll)) -! if(debugprint)print*,'sample ',ll,VarName,' = ',ll,pmid(isa,jsa,ll) - -! GFS is on A grid and does not need PMIDV - -! dp - VarName='dpres' -! write(0,*)' bef getnemsandscatter ll=',ll,' l=',l,VarName - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dpres(1,jsta_2l,ll)) -! if(debugprint)print*,'sample ',ll,VarName,' = ',ll,pmid(isa,jsa,ll) - endif -! ozone mixing ratio - VarName='o3mr' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,o3(1,jsta_2l,ll)) - -! if(debugprint)print*,'sample ',ll,VarName,' = ',ll,o3(isa,jsa,ll) -! write(1000+me,*)'sample ',ll,VarName,' = ',ll,o3(isa,jsa,ll) - -! cloud water and ice mixing ratio for zhao scheme -! need to look up old eta post to derive cloud water/ice from cwm -! Zhao scheme does not produce suspended rain and snow - -!$omp parallel do private(i,j) - do j = jsta, jend - do i=1,im - qqw(i,j,ll) = 0. - qqr(i,j,ll) = 0. - qqs(i,j,ll) = 0. - qqi(i,j,ll) = 0. - enddo - enddo - - VarName='clwmr' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,cwm(1,jsta_2l,ll)) -! if(debugprint)print*,'sample ',ll,VarName,' = ',ll,cwm(isa,jsa,ll) - -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if(t(i,j,ll) < (TFRZ-15.) )then ! dividing cloud water from ice - qqi(i,j,ll) = cwm(i,j,ll) - else - qqw(i,j,ll) = cwm(i,j,ll) - end if -! if (j == jm/2 .and. mod(i,50) == 0) -! + print*,'sample ',trim(VarName), ' after scatter= ' -! + ,i,j,ll,cwm(i,j,ll) - end do - end do -! if (iret /= 0)print*,'Error scattering array';stop - -! pressure vertical velocity - VarName='vvel' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,omga(1,jsta_2l,ll)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,omga(isa,jsa,ll) - -! With SHOC NEMS/GSM does output TKE now - VarName='tke' - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,q2(1,jsta_2l,ll)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,q2(isa,jsa,ll) - - - end do ! do loop for l - -! construct interface pressure from model top (which is zero) and dp from top down PDTOP -! pdtop = spval - pt = 0. -! pd = spval ! GFS does not output PD - - ii = im/2 - jj = (jsta+jend)/2 - -!!!!! COMPUTE Z, GFS integrates Z on mid-layer instead -!!! use GFS contants to see if height becomes more aggreable to GFS pressure grib file - if (hyb_sigp) then - do l=lm,1,-1 -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - pint(i,j,l) = ak5(lm+2-l) + bk5(lm+2-l)*pint(i,j,lp1) - pmid(i,j,l) = 0.5*(pint(i,j,l)+pint(i,j,l+1)) ! for now - Moorthi - enddo - enddo - if (me == 0) print*,'sample pint,pmid' ,ii,jj,l,pint(ii,jj,l),pmid(ii,jj,l) - enddo - else - do l=2,lm -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - pint(i,j,l) = pint(i,j,l-1) + dpres(i,j,l-1) - enddo - enddo - if (me == 0) print*,'sample pint,pmid' ,ii,jj,l,pint(ii,jj,l),pmid(ii,jj,l) - end do - endif - - allocate(wrk1(im,jsta:jend),wrk2(im,jsta:jend)) - allocate(fi(im,jsta:jend,2)) - -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - pd(i,j) = spval ! GFS does not output PD - pint(i,j,1) = PT - alpint(i,j,lp1) = log(pint(i,j,lp1)) - wrk1(i,j) = log(PMID(I,J,LM)) - wrk2(i,j) = T(I,J,LM)*(Q(I,J,LM)*fv+1.0) - FI(I,J,1) = FIS(I,J) & - + wrk2(i,j)*rgas*(ALPINT(I,J,Lp1)-wrk1(i,j)) - ZMID(I,J,LM) = FI(I,J,1) * gravi - end do - end do - - print *,' Tprof=',t(ii,jj,:) - print *,' Qprof=',q(ii,jj,:) - -! SECOND, INTEGRATE HEIGHT HYDROSTATICLY, GFS integrate height on mid-layer - - DO L=LM,2,-1 ! omit computing model top height because it's infinity - ll = l - 1 -! write(0,*)' me=',me,'ll=',ll,' gravi=',gravi,rgas,' fv=',fv -!$omp parallel do private(i,j,tvll,pmll,fact) - do j = jsta, jend -! write(0,*)' j=',j,' me=',me - do i = 1, im - alpint(i,j,l) = log(pint(i,j,l)) - tvll = T(I,J,LL)*(Q(I,J,LL)*fv+1.0) - pmll = log(PMID(I,J,LL)) - -! if (me == 0 .and. i == ii .and. j == jj ) print*,'L ZINT= ',l,' tvll =', tvll, & -! ' pmll=',pmll,' wrk2=',wrk2(i,j),' wrk1=',wrk1(i,j),' fi1=',fi(i,j,1), & -! ' T=',T(i,j,LL),' Q=',Q(i,j,ll) - - FI(I,J,2) = FI(I,J,1) + (0.5*rgas)*(wrk2(i,j)+tvll) & - * (wrk1(i,j)-pmll) - ZMID(I,J,LL) = FI(I,J,2) * gravi -! - FACT = (ALPINT(I,J,L)-wrk1(i,j)) / (pmll-wrk1(i,j)) - ZINT(I,J,L) = ZMID(I,J,L) + (ZMID(I,J,LL)-ZMID(I,J,L)) * FACT - FI(I,J,1) = FI(I,J,2) - wrk1(i,J) = pmll - wrk2(i,j) = tvll -! if (me == 0 .and. i == ii .and. j == jj ) print*,'L ZINT= ',l,zint(ii,jj,l), & -! 'alpint=',ALPINT(ii,jj,l),'pmid=',LOG(PMID(Ii,Jj,L)),'pmid(l-1)=', & -! LOG(PMID(Ii,Jj,L-1)),'zmd=',ZMID(Ii,Jj,L),'zmid(l-1)=',ZMID(Ii,Jj,L-1) - ENDDO - ENDDO - - if (me == 0) print*,'L ZINT= ',l,zint(ii,jj,l), & - 'alpint=',ALPINT(ii,jj,l),'pmid=',LOG(PMID(Ii,Jj,L)),'pmid(l-1)=', & - LOG(PMID(Ii,Jj,L-1)),'zmd=',ZMID(Ii,Jj,L),'zmid(l-1)=',ZMID(Ii,Jj,L-1) - ENDDO - deallocate(wrk1,wrk2,fi) - - - if (gocart_on) then - -! GFS output dust in nemsio (GOCART) - do n=1,nbin_du - do l=1,lm -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - dust(i,j,l,n) = spval - enddo - enddo - enddo - enddo -! DUST = SPVAL - VarName='du001' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dust(1,jsta_2l,ll,1)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,dust(isa,jsa,ll,1) - end do ! do loop for l - - VarName='du002' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dust(1,jsta_2l,ll,2)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,dust(isa,jsa,ll,2) - end do ! do loop for l - - VarName='du003' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dust(1,jsta_2l,ll,3)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,dust(isa,jsa,ll,3) - end do ! do loop for l - - VarName='du004' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dust(1,jsta_2l,ll,4)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,dust(isa,jsa,ll,4) - end do ! do loop for l - - VarName='du005' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dust(1,jsta_2l,ll,5)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,dust(isa,jsa,ll,5) - end do ! do loop for l -! -! GFS output sea salt in nemsio (GOCART) - do n=1,nbin_ss - do l=1,lm -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - salt(i,j,l,n) = spval - enddo - enddo - enddo - enddo -! SALT = SPVAL - VarName='ss001' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,salt(1,jsta_2l,ll,1)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,salt(isa,jsa,ll,1) - end do ! do loop for l - - VarName='ss002' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,salt(1,jsta_2l,ll,2)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,salt(isa,jsa,ll,2) - end do ! do loop for l - - VarName='ss003' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,salt(1,jsta_2l,ll,3)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,salt(isa,jsa,ll,3) - end do ! do loop for l - - VarName='ss004' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,salt(1,jsta_2l,ll,4)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,salt(isa,jsa,ll,4) - end do ! do loop for l - - VarName='ss005' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,salt(1,jsta_2l,ll,5)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,salt(isa,jsa,ll,5) - end do ! do loop for l - -! GFS output black carbon in nemsio (GOCART) - do n=1,nbin_oc - do l=1,lm -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - soot(i,j,l,n) = spval - enddo - enddo - enddo - enddo -! SOOT = SPVAL - VarName='bcphobic' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,soot(1,jsta_2l,ll,1)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,soot(isa,jsa,ll,1) - end do ! do loop for l - - VarName='bcphilic' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,soot(1,jsta_2l,ll,2)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,soot(isa,jsa,ll,2) - end do ! do loop for l - -! GFS output organic carbon in nemsio (GOCART) - do n=1,nbin_oc - do l=1,lm -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - waso(i,j,l,n) = spval - enddo - enddo - enddo - enddo -! WASO = SPVAL - VarName='ocphobic' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,waso(1,jsta_2l,ll,1)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,waso(isa,jsa,ll,1) - end do ! do loop for l - - VarName='ocphilic' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,waso(1,jsta_2l,ll,2)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,waso(isa,jsa,ll,2) - end do ! do loop for l - -! GFS output sulfate in nemsio (GOCART) - do n=1,nbin_su - do l=1,lm -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - suso(i,j,l,n) = spval - enddo - enddo - enddo - enddo -! SUSO = SPVAL - VarName='so4' - VcoordName='mid layer' - do l=1,lm - ll=lm-l+1 - call getnemsandscatter(me,nfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,suso(1,jsta_2l,ll,1)) -! if(debugprint)print*,'sample l ',VarName,' = ',ll,suso(isa,jsa,ll,1) - end do ! do loop for l - - -! -- compute air density RHOMID and remove negative tracer values - do l=1,lm -!$omp parallel do private(i,j,n,tv) - do j=jsta,jend - do i=1,im - - TV = T(I,J,L) * (H1+D608*MAX(Q(I,J,L),QMIN)) - RHOMID(I,J,L) = PMID(I,J,L) / (RD*TV) - do n = 1, NBIN_DU - IF ( dust(i,j,l,n) < SPVAL) THEN - DUST(i,j,l,n) = MAX(DUST(i,j,l,n), 0.0) - ENDIF - enddo - do n = 1, NBIN_SS - IF ( salt(i,j,l,n) < SPVAL) THEN - SALT(i,j,l,n) = MAX(SALT(i,j,l,n), 0.0) - ENDIF - enddo - do n = 1, NBIN_OC - IF ( waso(i,j,l,n) < SPVAL) THEN - WASO(i,j,l,n) = MAX(WASO(i,j,l,n), 0.0) - ENDIF - enddo - do n = 1, NBIN_BC - IF ( soot(i,j,l,n) < SPVAL) THEN - SOOT(i,j,l,n) = MAX(SOOT(i,j,l,n), 0.0) - ENDIF - enddo - do n = 1, NBIN_SU - IF ( suso(i,j,l,n) < SPVAL) THEN - SUSO(i,j,l,n) = MAX(SUSO(i,j,l,n), 0.0) - ENDIF - enddo - - end do - end do - end do - endif ! endif for gocart_on -! - -! PBL height using nemsio - VarName='hpbl' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,pblh) -! if(debugprint)print*,'sample ',VarName,' = ',pblh(isa,jsa) - -! frictional velocity using nemsio - VarName='fricv' -! VcoordName='sfc' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,ustar) -! if(debugprint)print*,'sample ',VarName,' = ',ustar(isa,jsa) - -! roughness length using getgb - VarName='sfcr' -! VcoordName='sfc' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,z0) -! if(debugprint)print*,'sample ',VarName,' = ',z0(isa,jsa) - -! surface potential T using getgb - VarName='tmp' -! VcoordName='sfc' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,ths) - -! where(ths/=spval)ths=ths*(p1000/pint(:,:,lp1))**CAPA ! convert to THS - -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (ths(i,j) /= spval) then -! write(0,*)' i=',i,' j=',j,' ths=',ths(i,j),' pint=',pint(i,j,lp1) - ths(i,j) = ths(i,j) * (p1000/pint(i,j,lp1))**capa - endif - QS(i,j) = SPVAL ! GFS does not have surface specific humidity - twbs(i,j) = SPVAL ! GFS does not have inst sensible heat flux - qwbs(i,j) = SPVAL ! GFS does not have inst latent heat flux - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',ths(isa,jsa) - - -! GFS does not have time step and physics time step, make up ones since they -! are not really used anyway - NPHS=2. - DT=80. - DTQ2 = DT * NPHS !MEB need to get physics DT - TSPH = 3600./DT !MEB need to get DT -! All GFS time-averaged quantities are in 6 hour bucket -! TPREC=6.0 - -! convective precip in m per physics time step using gfsio -! VarName='cprat' -! VcoordName='sfc' -! l=1 -! if(me == 0)then -! call gfsio_readrecvw34(gfile,trim(VarName),trim(VcoordName) & -! + ,l,dummy,iret=iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! dummy=spval -! else -! do j = 1, jm -! do i = 1, im -! dummy(I,J)= dummy(i,j)*dtq2/1000. ! convert to m -! if (j == jm/2 .and. mod(i,50) == 0) -! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) -! enddo -! enddo -! end if -! end if -! call mpi_scatterv(dummy,icnt,idsp,mpi_real & -! + , avgcprate(1,jsta),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) -! if (iret /= 0)print*,'Error scattering array';stop - -! convective precip in m per physics time step using getgb - VarName='cprat' -! VcoordName='sfc' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,avgcprate) -! where(avgcprate /= spval)avgcprate=avgcprate*dtq2/1000. ! convert to m -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (avgcprate(i,j) /= spval) avgcprate(i,j) = avgcprate(i,j) * (dtq2*0.001) - cprate(i,j) = avgcprate(i,j) - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',avgcprate(isa,jsa) - -! print*,'maxval CPRATE: ', maxval(CPRATE) - -! precip rate in m per physics time step using getgb - VarName='prate' -! VcoordName='sfc' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,avgprec) -! where(avgprec /= spval)avgprec=avgprec*dtq2/1000. ! convert to m -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (avgprec(i,j) /= spval) avgprec(i,j) = avgprec(i,j) * (dtq2*0.001) - enddo - enddo - -! if(debugprint)print*,'sample ',VarName,' = ',avgprec(isa,jsa) - - prec=avgprec !set avg cprate to inst one to derive other fields - -! GFS does not have accumulated total, gridscale, and convective precip, will use inst precip to derive in SURFCE.f - - -! inst snow water eqivalent using nemsio - VarName='weasd' -! VcoordName='sfc' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,sno) -! if(debugprint)print*,'sample ',VarName,' = ',sno(isa,jsa) - -! snow depth in mm using nemsio - VarName='snod' -! VcoordName='sfc' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,si) -! where(si /= spval)si=si*1000. ! convert to mm -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (si(i,j) /= spval) si(i,j) = si(i,j) * 1000.0 - CLDEFI(i,j) = SPVAL ! GFS does not have convective cloud efficiency - lspa(i,j) = spval ! GFS does not have similated precip - TH10(i,j) = SPVAL ! GFS does not have 10 m theta - TH10(i,j) = SPVAL ! GFS does not have 10 m theta - Q10(i,j) = SPVAL ! GFS does not have 10 m humidity - ALBASE(i,j) = SPVAL ! GFS does not have snow free albedo - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',si(isa,jsa) - -!!$omp parallel do private(i,j,l) -! do l=1,lm -! do j=jsta,jend -! do i=1,im -! Q2(i,j,l) = SPVAL ! GFS does not have TKE because it uses MRF scheme -! ! GFS does not have surface exchange coeff -! enddo -! enddo -! enddo - -! 2m T using nemsio - VarName='tmp' - VcoordName='2 m above gnd' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,tshltr) -! if(debugprint)print*,'sample ',VarName,' = ',tshltr(isa,jsa) - -! GFS does not have 2m pres, estimate it, also convert t to theta - Do j=jsta,jend - Do i=1,im - PSHLTR(I,J)=pint(I,J,lm+1)*EXP(-0.068283/tshltr(i,j)) - tshltr(i,j)= tshltr(i,j)*(p1000/PSHLTR(I,J))**CAPA ! convert to theta -! if (j == jm/2 .and. mod(i,50) == 0) -! + print*,'sample 2m T and P after scatter= ' -! + ,i,j,tshltr(i,j),pshltr(i,j) - end do - end do - -! 2m specific humidity using gfsio -! VarName='spfh' -! VcoordName='2m above gnc' -! l=1 -! if(me == 0)then -! call gfsio_readrecvw34(gfile,trim(VarName),trim(VcoordName) & -! + ,l,dummy,iret=iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! dummy=spval -! end if -! end if -! call mpi_scatterv(dummy,icnt,idsp,mpi_real & -! + ,qshltr(1,jsta),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) -! if (iret /= 0)print*,'Error scattering array';stop - -! 2m specific humidity using nemsio - VarName='spfh' - VcoordName='2 m above gnd' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,qshltr) -! if(debugprint)print*,'sample ',VarName,' = ',qshltr(isa,jsa) - - -! mid day avg albedo in fraction using gfsio -! VarName='albdo' -! VcoordName='sfc' -! l=1 -! if(me == 0)then -! call gfsio_readrecvw34(gfile,trim(VarName),trim(VcoordName) & -! + ,l,dummy,iret=iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! dummy=spval -! else -! do j = 1, jm -! do i = 1, im -! dummy(I,J)= dummy(i,j)/100. ! convert to fraction -! if (j == jm/2 .and. mod(i,50) == 0) -! + print*,'sample ',VarName, ' = ',i,j,dummy(i,j) -! enddo -! enddo -! end if -! end if -! call mpi_scatterv(dummy,icnt,idsp,mpi_real & -! + ,avgalbedo(1,jsta),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) -! if (iret /= 0)print*,'Error scattering array';stop - -! mid day avg albedo in fraction using nemsio - VarName='albdo' - VcoordName='sfc' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,avgalbedo) -! where(avgalbedo /= spval)avgalbedo=avgalbedo/100. ! convert to fraction -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (avgalbedo(i,j) /= spval) avgalbedo(i,j) = avgalbedo(i,j) * 0.01 - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',avgalbedo(isa,jsa) - -! time averaged column cloud fractionusing nemsio - VarName='tcdc' - VcoordName='atmos col' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,avgtcdc) -! where(avgtcdc /= spval)avgtcdc=avgtcdc/100. ! convert to fraction -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (avgtcdc(i,j) /= spval) avgtcdc(i,j) = avgtcdc(i,j) * 0.01 - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',avgtcdc(isa,jsa) - -! GFS probably does not use zenith angle -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - Czen(i,j) = spval - CZMEAN(i,j) = SPVAL - enddo - enddo - -! maximum snow albedo in fraction using nemsio - VarName='mxsalb' - VcoordName='sfc' -! l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,mxsnal) -! where(mxsnal /= spval)mxsnal=mxsnal/100. ! convert to fraction -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (mxsnal(i,j) /= spval) mxsnal(i,j) = mxsnal(i,j) * 0.01 - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',mxsnal(isa,jsa) - -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - radot(i,j) = spval ! GFS does not have inst surface outgoing longwave - enddo - enddo - -! GFS probably does not use sigt4, set it to sig*t^4 -!$omp parallel do private(i,j,tlmh) - Do j=jsta,jend - Do i=1,im - TLMH = T(I,J,LM) * T(I,J,LM) - Sigt4(i,j) = 5.67E-8 * TLMH * TLMH - End do - End do - -! TG is not used, skip it for now - -! will retrive f_ice when GFS switches to Ferrier scheme -! varname='F_ICE' -! call retrieve_index(index,VarName,varname_all,nrecs,iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! F_ice=SPVAL -! else -! this_offset=file_offset(index+1)+(jsta_2l-1)*4*im*lm -! this_length=im*(jend_2u-jsta_2l+1)*lm -! call mpi_file_read_at(iunit,this_offset -! + ,buf3d,this_length,mpi_real4 -! + , mpi_status_ignore, ierr) -! if (ierr /= 0) then -! print*,"Error reading ", VarName,"Assigned missing values" -! F_ice=SPVAL -! else -! do l = 1, lm -! ll=lm-l+1 -! do j = jsta_2l, jend_2u -! do i = 1, im -! F_ice( i, j, l ) = buf3d ( i, ll, j ) -! if(i == im/2.and.j == (jsta+jend)/2)print*,'sample F_ice= ', -! + i,j,l,F_ice( i, j, l ) -! end do -! end do -! end do -! end if -! end if - -! varname='F_RAIN' -! call retrieve_index(index,VarName,varname_all,nrecs,iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! F_rain=SPVAL -! else -! this_offset=file_offset(index+1)+(jsta_2l-1)*4*im*lm -! this_length=im*(jend_2u-jsta_2l+1)*lm -! call mpi_file_read_at(iunit,this_offset -! + ,buf3d,this_length,mpi_real4 -! + , mpi_status_ignore, ierr) -! if (ierr /= 0) then -! print*,"Error reading ", VarName,"Assigned missing values" -! F_rain=SPVAL -! else -! do l = 1, lm -! ll=lm-l+1 -! do j = jsta_2l, jend_2u -! do i = 1, im -! F_rain( i, j, l ) = buf3d ( i, ll, j ) -! if(i == im/2.and.j == (jsta+jend)/2)print*,'sample F_rain= ', -! + i,j,l,F_rain( i, j, l ) -! end do -! end do -! end do -! end if -! end if - -! varname='F_RIMEF' -! call retrieve_index(index,VarName,varname_all,nrecs,iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! F_RimeF=SPVAL -! else -! this_offset=file_offset(index+1)+(jsta_2l-1)*4*im*lm -! this_length=im*(jend_2u-jsta_2l+1)*lm -! call mpi_file_read_at(iunit,this_offset -! + ,buf3d,this_length,mpi_real4 -! + , mpi_status_ignore, ierr) -! if (ierr /= 0) then -! print*,"Error reading ", VarName,"Assigned missing values" -! F_RimeF=SPVAL -! else -! do l = 1, lm -! ll=lm-l+1 -! do j = jsta_2l, jend_2u -! do i = 1, im -! F_RimeF( i, j, l ) = buf3d ( i, ll, j ) -! if(i == im/2.and.j == (jsta+jend)/2)print*, -! + 'sample F_RimeF= ',i,j,l,F_RimeF( i, j, l ) -! end do -! end do -! end do -! end if -! end if - -! GFS does not have model level cloud fraction -> derive cloud fraction -! CFR=SPVAL -! allocate(qstl(lm)) -! print*,'start deriving cloud fraction' - -! do j=jsta,jend -! do i=1,im -! do l=1,lm -! if(i==im/2.and.j==jsta)print*,'sample T=',t(i,j,l) -! es=fpvsnew(t(i,j,l)) -! if(i==im/2.and.j==jsta)print*,'sample ES=',es -! es=min(es,pmid(i,j,l)) -! if(i==im/2.and.j==jsta)print*,'sample ES=',es -! qstl(l)=con_eps*es/(pmid(i,j,l)+con_epsm1*es) !saturation q for GFS -! end do -! call progcld1 -!................................... - -! --- inputs: -! & ( pmid(i,j,1:lm)/100.,pint(i,j,1:lm+1)/100., -! & t(i,j,1:lm),q(i,j,1:lm),qstl,cwm(i,j,1:lm), -! & gdlat(i,j),gdlon(i,j), -! & 1, lm, lm+1, 0, -! --- outputs: -! & cfr(i,j,1:lm) -! & ) -! do l=1,lm -! cfr(i,j,l)=cldtot(l) -! end do -! end do -! end do - allocate(p2d(im,lm),t2d(im,lm),q2d(im,lm),cw2d(im,lm), & - qs2d(im,lm),cfr2d(im,lm)) - do j=jsta,jend -!$omp parallel do private(i,k,es) - do k=1,lm - do i=1,im - p2d(i,k) = pmid(i,j,k)*0.01 - t2d(i,k) = t(i,j,k) - q2d(i,k) = q(i,j,k) - cw2d(i,k) = cwm(i,j,k) - es = min(fpvsnew(t(i,j,k)),pmid(i,j,k)) - qs2d(i,k) = eps*es/(pmid(i,j,k)+epsm1*es)!saturation q for GFS - enddo - enddo - call progcld1 & -!................................... -! --- inputs: - ( p2d,t2d,q2d,qs2d,cw2d,im,lm,0, & -! --- outputs: - cfr2d & - ) -!$omp parallel do private(i,k) - do k=1,lm - do i=1,im - cfr(i,j,k) = cfr2d(i,k) - enddo - end do - end do - deallocate(p2d,t2d,q2d,qs2d,cw2d,cfr2d) - - -! ask murthy if there is snow rate in GFS -! varname='SR' -! call retrieve_index(index,VarName,varname_all,nrecs,iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! SR=SPVAL -! else -! this_offset=file_offset(index+1)+(jsta_2l-1)*4*im -! this_length=im*(jend_2u-jsta_2l+1) -! call mpi_file_read_at(iunit,this_offset -! + ,sr,this_length,mpi_real4 -! + , mpi_status_ignore, ierr) -! if (ierr /= 0) then -! print*,"Error reading ", VarName,"Assigned missing values" -! SR=SPVAL -! end if -! end if - -! GFS does not have inst cloud fraction for high, middle, and low cloud -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - cfrach(i,j) = spval - cfracl(i,j) = spval - cfracm(i,j) = spval - enddo - enddo - -! ave high cloud fraction using nemsio - VarName='tcdc' - VcoordName='high cld lay' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,avgcfrach) -! where(avgcfrach /= spval)avgcfrach=avgcfrach/100. ! convert to fraction -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (avgcfrach(i,j) /= spval) avgcfrach(i,j) = avgcfrach(i,j) * 0.01 - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',avgcfrach(isa,jsa) - -! ave low cloud fraction using nemsio - VarName='tcdc' - VcoordName='low cld lay' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,avgcfracl) -! where(avgcfracl /= spval)avgcfracl=avgcfracl/100. ! convert to fraction -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (avgcfracl(i,j) /= spval) avgcfracl(i,j) = avgcfracl(i,j) * 0.01 - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',avgcfracl(isa,jsa) - -! ave middle cloud fraction using nemsio - VarName='tcdc' - VcoordName='mid cld lay' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,avgcfracm) -! where(avgcfracm /= spval)avgcfracm=avgcfracm/100. ! convert to fraction -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (avgcfracm(i,j) /= spval) avgcfracm(i,j) = avgcfracm(i,j) * 0.01 - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',avgcfracm(isa,jsa) - -! inst convective cloud fraction using nemsio - VarName='tcdc' - VcoordName='convect-cld laye' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,cnvcfr) -! where(cnvcfr /= spval)cnvcfr=cnvcfr/100. ! convert to fraction -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (cnvcfr(i,j) /= spval) cnvcfr (i,j)= cnvcfr(i,j) * 0.01 - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',cnvcfr(isa,jsa) - -! slope type using nemsio - VarName='sltyp' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,buf) -! where(buf /= spval)islope=nint(buf) -!$omp parallel do private(i,j) - do j = jsta_2l, jend_2u - do i=1,im - if (buf(i,j) < spval) then - islope(i,j) = nint(buf(i,j)) - else - islope(i,j) = 0 - endif - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',islope(isa,jsa) - -! plant canopy sfc wtr in m using nemsio - VarName='cnwat' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,cmc) -! where(cmc /= spval)cmc=cmc/1000. ! convert from kg*m^2 to m -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (cmc(i,j) /= spval) cmc(i,j) = cmc(i,j) * 0.001 - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',cmc(isa,jsa) - -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - grnflx(i,j) = spval ! GFS does not have inst ground heat flux - enddo - enddo - -! GFS does not have snow cover yet -! VarName='gflux' -! VcoordName='sfc' -! l=1 -! if(me == 0)then -! call gfsio_readrecvw34(gfile,trim(VarName),trim(VcoordName) & -! + ,l,dummy,iret=iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! dummy=spval -! end if -! end if -! call mpi_scatterv(dummy,icnt,idsp,mpi_real & -! + , pctsno(1,jsta),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) -! if (iret /= 0)print*,'Error scattering array';stop - -! asuume tg3 in GFS is the same as soiltb in wrf nmm. It's in sfc file, will -! be able to read it when it merges to gfs io -! soiltb is not being put out, comment it out -! VarName='tg3' -! VcoordName='sfc' -! l=1 -! if(me == 0)then -! call gfsio_readrecvw34(gfile,trim(VarName),trim(VcoordName) & -! ,l,dummy,iret=iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! dummy=spval -! end if -! end if -! call mpi_scatterv(dummy(1,1),icnt,idsp,mpi_real & -! , soiltb(1,jsta),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) -! if (iret /= 0)print*,'Error scattering array';stop - -! vegetation fraction in fraction. using nemsio - VarName='veg' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,vegfrc) -! where(vegfrc /= spval) -! vegfrc=vegfrc/100. ! convert to fraction -! elsewhere (vegfrc == spval) -! vegfrc=0. ! set to zero to be reasonable input for crtm -! end where -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (vegfrc(i,j) /= spval) then - vegfrc(i,j) = vegfrc(i,j) * 0.01 - else - vegfrc(i,j) = 0.0 - endif - enddo - enddo -! if(debugprint)print*,'sample ',VarName,' = ',vegfrc(isa,jsa) - -! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam - - SLDPTH(1) = 0.10 - SLDPTH(2) = 0.3 - SLDPTH(3) = 0.6 - SLDPTH(4) = 1.0 - -! liquid volumetric soil mpisture in fraction using nemsio - VarName='soill' - VcoordName='0-10 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,sh2o(1,jsta_2l,1)) -! if(debugprint)print*,'sample l',VarName,' = ',1,sh2o(isa,jsa,1) - - VarName='soill' - VcoordName='10-40 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,sh2o(1,jsta_2l,2)) -! if(debugprint)print*,'sample l',VarName,' = ',1,sh2o(isa,jsa,2) - - VarName='soill' - VcoordName='40-100 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,sh2o(1,jsta_2l,3)) -! if(debugprint)print*,'sample l',VarName,' = ',1,sh2o(isa,jsa,3) - - VarName='soill' - VcoordName='100-200 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,sh2o(1,jsta_2l,4)) -! if(debugprint)print*,'sample l',VarName,' = ',1,sh2o(isa,jsa,4) - -! volumetric soil moisture using nemsio - VarName='soilw' - VcoordName='0-10 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,smc(1,jsta_2l,1)) -! if(debugprint)print*,'sample l',VarName,' = ',1,smc(isa,jsa,1) - - VarName='soilw' - VcoordName='10-40 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,smc(1,jsta_2l,2)) -! if(debugprint)print*,'sample l',VarName,' = ',1,smc(isa,jsa,2) - - VarName='soilw' - VcoordName='40-100 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,smc(1,jsta_2l,3)) -! if(debugprint)print*,'sample l',VarName,' = ',1,smc(isa,jsa,3) - - VarName='soilw' - VcoordName='100-200 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,smc(1,jsta_2l,4)) -! if(debugprint)print*,'sample l',VarName,' = ',1,smc(isa,jsa,4) - -! soil temperature using nemsio - VarName='tmp' - VcoordName='0-10 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,stc(1,jsta_2l,1)) -! if(debugprint)print*,'sample l','stc',' = ',1,stc(isa,jsa,1) - - VarName='tmp' - VcoordName='10-40 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,stc(1,jsta_2l,2)) -! if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,2) - - VarName='tmp' - VcoordName='40-100 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,stc(1,jsta_2l,3)) -! if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,3) - - VarName='tmp' - VcoordName='100-200 cm down' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,stc(1,jsta_2l,4)) -! if(debugprint)print*,'sample stc = ',1,stc(isa,jsa,4) - -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - acfrcv(i,j) = spval ! GFS does not output time averaged convective and strat cloud fraction, set acfrcv to spval, ncfrcv to 1 - ncfrcv(i,j) = 1.0 - acfrst(i,j) = spval ! GFS does not output time averaged cloud fraction, set acfrst to spval, ncfrst to 1 - ncfrst(i,j) = 1.0 - ssroff(i,j) = spval ! GFS does not have storm runoff - bgroff(i,j) = spval ! GFS does not have UNDERGROUND RUNOFF - rlwin(i,j) = spval ! GFS does not have inst incoming sfc longwave - rlwtoa(i,j) = spval ! GFS does not have inst model top outgoing longwave - enddo - enddo -! trdlw(i,j) = 6.0 - ardlw = 1.0 ! GFS incoming sfc longwave has been averaged over 6 hr bucket, set ARDLW to 1 - -! time averaged incoming sfc longwave using nemsio - VarName='dlwrf' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,alwin) - -! time averaged outgoing sfc longwave using gfsio - VarName='ulwrf' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,alwout) -! where(alwout /= spval) alwout=-alwout ! CLDRAD puts a minus sign before gribbing -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (alwout(i,j) /= spval) alwout(i,j) = -alwout(i,j) - enddo - enddo -! if(debugprint)print*,'sample l',VarName,' = ',1,alwout(isa,jsa) - -! time averaged outgoing model top longwave using gfsio - VarName='ulwrf' - VcoordName='nom. top' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,alwtoa) -! if(debugprint)print*,'sample l',VarName,' = ',1,alwtoa(isa,jsa) - -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - rswin(i,j) = spval ! GFS does not have inst incoming sfc shortwave - rswinc(i,j) = spval ! GFS does not have inst incoming clear sky sfc shortwave - rswout(i,j) = spval ! GFS does not have inst outgoing sfc shortwave - enddo - enddo - -! GFS incoming sfc longwave has been averaged, set ARDLW to 1 - ardsw=1.0 -! trdsw=6.0 - -! time averaged incoming sfc shortwave using gfsio - VarName='dswrf' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,aswin) -! if(debugprint)print*,'sample l',VarName,' = ',1,aswin(isa,jsa) - -! time averaged incoming sfc uv-b using getgb - VarName='duvb' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,auvbin) -! if(debugprint)print*,'sample l',VarName,' = ',1,auvbin(isa,jsa) - -! time averaged incoming sfc clear sky uv-b using getgb - VarName='cduvb' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,auvbinc) -! if(debugprint)print*,'sample l',VarName,' = ',1,auvbinc(isa,jsa) - -! time averaged outgoing sfc shortwave using gfsio - VarName='uswrf' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,aswout) -! where(aswout /= spval) aswout=-aswout ! CLDRAD puts a minus sign before gribbing -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (aswout(i,j) /= spval) aswout(i,j) = -aswout(i,j) - enddo - enddo -! if(debugprint)print*,'sample l',VarName,' = ',1,aswout(isa,jsa) - -! time averaged model top incoming shortwave - VarName='dswrf' - VcoordName='nom. top' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,aswintoa) - -! time averaged model top outgoing shortwave - VarName='uswrf' - VcoordName='nom. top' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,aswtoa) -! if(debugprint)print*,'sample l',VarName,' = ',1,aswtoa(isa,jsa) - -! time averaged surface sensible heat flux, multiplied by -1 because wrf model flux -! has reversed sign convention using gfsio - VarName='shtfl' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,sfcshx) -! where (sfcshx /= spval)sfcshx=-sfcshx -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (sfcshx(i,j) /= spval) sfcshx(i,j) = -sfcshx(i,j) - enddo - enddo -! if(debugprint)print*,'sample l',VarName,' = ',1,sfcshx(isa,jsa) - -! GFS surface flux has been averaged, set ASRFC to 1 - asrfc=1.0 -! tsrfc=6.0 - -! time averaged surface latent heat flux, multiplied by -1 because wrf model flux -! has reversed sign vonvention using gfsio - VarName='lhtfl' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,sfclhx) -! where (sfclhx /= spval)sfclhx=-sfclhx -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - if (sfclhx(i,j) /= spval) sfclhx(i,j) = -sfclhx(i,j) - enddo - enddo -! if(debugprint)print*,'sample l',VarName,' = ',1,sfclhx(isa,jsa) - -! time averaged ground heat flux using nemsio - VarName='gflux' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,subshx) -! if(debugprint)print*,'sample l',VarName,' = ',1,subshx(isa,jsa) - -! time averaged zonal momentum flux using gfsio - VarName='uflx' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,sfcux) -! if(debugprint)print*,'sample l',VarName,' = ',1,sfcux(isa,jsa) - -! time averaged meridional momentum flux using nemsio - VarName='vflx' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,sfcvx) -! if(debugprint)print*,'sample l',VarName,' = ',1,sfcvx(isa,jsa) - -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - snopcx(i,j) =spval ! GFS does not have snow phase change heat flux - sfcuvx(i,j) = spval ! GFS does not use total momentum flux - enddo - enddo - -! time averaged zonal gravity wave stress using nemsio - VarName='u-gwd' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,gtaux) -! if(debugprint)print*,'sample l',VarName,' = ',1,gtaux(isa,jsa) - -! time averaged meridional gravity wave stress using getgb - VarName='v-gwd' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,gtauy) -! if(debugprint)print*,'sample l',VarName,' = ',1,gtauy(isa,jsa) - -! time averaged accumulated potential evaporation - VarName='pevpr' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,potevp) -! if(debugprint)print*,'sample l',VarName,' = ',1,potevp(isa,jsa) - - do l=1,lm -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im -! GFS does not have temperature tendency due to long wave radiation - rlwtt(i,j,l) = spval -! GFS does not have temperature tendency due to short wave radiation - rswtt(i,j,l) = spval -! GFS does not have temperature tendency due to latent heating from convection - tcucn(i,j,l) = spval - tcucns(i,j,l) = spval -! GFS does not have temperature tendency due to latent heating from grid scale - train(i,j,l) = spval - enddo - enddo - enddo - -! set avrain to 1 - avrain=1.0 - avcnvc=1.0 - theat=6.0 ! just in case GFS decides to output T tendency - -! 10 m u using nemsio - VarName='ugrd' - VcoordName='10 m above gnd' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,u10) -! if(debugprint)print*,'sample l',VarName,' = ',1,u10(isa,jsa) - do j=jsta,jend - do i=1,im - u10h(i,j)=u10(i,j) - end do - end do - -! 10 m v using gfsio - VarName='vgrd' - VcoordName='10 m above gnd' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,v10) - do j=jsta,jend - do i=1,im - v10h(i,j)=v10(i,j) - end do - end do -! if(debugprint)print*,'sample l',VarName,' = ',1,v10(isa,jsa) - -! vegetation type, it's in GFS surface file, hopefully will merge into gfsio soon - VarName='vgtyp' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,buf) -! where (buf /= spval) -! ivgtyp=nint(buf) -! elsewhere -! ivgtyp=0 !need to feed reasonable value to crtm -! end where -!$omp parallel do private(i,j) - do j = jsta_2l, jend_2u - do i=1,im - if (buf(i,j) < spval) then - ivgtyp(i,j) = nint(buf(i,j)) - else - ivgtyp(i,j) = 0 - endif - enddo - enddo -! if(debugprint)print*,'sample l',VarName,' = ',1,ivgtyp(isa,jsa) - -! soil type, it's in GFS surface file, hopefully will merge into gfsio soon - VarName='sotyp' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,buf) -! where (buf /= spval) -! isltyp=nint(buf) -! elsewhere -! isltyp=0 !need to feed reasonable value to crtm -! end where -!$omp parallel do private(i,j) - do j = jsta_2l, jend_2u - do i=1,im - if (buf(i,j) < spval) then - isltyp(i,j) = nint(buf(i,j)) - else - isltyp(i,j) = 0 - endif - enddo - enddo -! if(debugprint)print*,'sample l',VarName,' = ',1,isltyp(isa,jsa) - -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - smstav(i,j) = spval ! GFS does not have soil moisture availability - smstot(i,j) = spval ! GFS does not have total soil moisture - sfcevp(i,j) = spval ! GFS does not have accumulated surface evaporation - sfcexc(i,j) = spval ! GFS does not have surface exchange coefficient - acsnow(i,j) = spval ! GFS does not have averaged accumulated snow - acsnom(i,j) = spval ! GFS does not have snow melt - sst(i,j) = spval ! GFS does not have sst???? - thz0(i,j) = ths(i,j) ! GFS does not have THZ0, use THS to substitute - qz0(i,j) = spval ! GFS does not output humidity at roughness length - uz0(i,j) = spval ! GFS does not output u at roughness length - vz0(i,j) = spval ! GFS does not output humidity at roughness length - enddo - enddo - do l=1,lm -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - EL_PBL(i,j,l) = spval ! GFS does not have mixing length - exch_h(i,j,l) = spval ! GFS does not output exchange coefficient - enddo - enddo - enddo -! if(debugprint)print*,'sample l',VarName,' = ',1,thz0(isa,jsa) - -! retrieve inst convective cloud top, GFS has cloud top pressure instead of index, -! will need to modify CLDRAD.f to use pressure directly instead of index - VarName='pres' - VcoordName='convect-cld top' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,ptop) -! if(debugprint)print*,'sample l',VarName,' = ',1,ptop(isa,jsa) - -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - htop(i,j) = spval - if(ptop(i,j) <= 0.0) ptop(i,j) = spval - enddo - enddo - do j=jsta,jend - do i=1,im - if(ptop(i,j) < spval)then - do l=1,lm - if(ptop(i,j) <= pmid(i,j,l))then - htop(i,j) = l -! if(i==ii .and. j==jj)print*,'sample ptop,pmid pmid-1,pint= ', & -! ptop(i,j),pmid(i,j,l),pmid(i,j,l-1),pint(i,j,l),htop(i,j) - exit - end if - end do - end if - end do - end do - -! retrieve inst convective cloud bottom, GFS has cloud top pressure instead of index, -! will need to modify CLDRAD.f to use pressure directly instead of index - VarName='pres' - VcoordName='convect-cld bot' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,pbot) -! if(debugprint)print*,'sample l',VarName,VcoordName,' = ',1,pbot(isa,jsa) - -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - hbot(i,j) = spval - if(pbot(i,j) <= 0.0) pbot(i,j) = spval - enddo - enddo - do j=jsta,jend - do i=1,im -! if(.not.lb(i,j))print*,'false bitmask for pbot at ' -! + ,i,j,pbot(i,j) - if(pbot(i,j) < spval)then - do l=lm,1,-1 - if(pbot(i,j) >= pmid(i,j,l)) then - hbot(i,j) = l -! if(i==ii .and. j==jj)print*,'sample pbot,pmid= ', & -! pbot(i,j),pmid(i,j,l),hbot(i,j) - exit - end if - end do - end if - end do - end do - -! retrieve time averaged low cloud top pressure using nemsio - VarName='pres' - VcoordName='low cld top' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,ptopl) -! if(debugprint)print*,'sample l',VarName,' = ',1,ptopl(isa,jsa) - -! retrieve time averaged low cloud bottom pressure using nemsio - VarName='pres' - VcoordName='low cld bot' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,pbotl) -! if(debugprint)print*,'sample l',VarName,' = ',1,pbotl(isa,jsa) - -! retrieve time averaged low cloud top temperature using nemsio - VarName='tmp' - VcoordName='low cld top' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,Ttopl) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,Ttopl(isa,jsa) - -! retrieve time averaged middle cloud top pressure using nemsio - VarName='pres' - VcoordName='mid cld top' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,ptopm) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,ptopm(isa,jsa) - -! retrieve time averaged middle cloud bottom pressure using nemsio - VarName='pres' - VcoordName='mid cld bot' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,pbotm) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,pbotm(isa,jsa) - -! retrieve time averaged middle cloud top temperature using nemsio - VarName='tmp' - VcoordName='mid cld top' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,Ttopm) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,Ttopm(isa,jsa) - -! retrieve time averaged high cloud top pressure using nemsio ********* - VarName='pres' - VcoordName='high cld top' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,ptoph) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,ptoph(isa,jsa) - -! retrieve time averaged high cloud bottom pressure using nemsio - VarName='pres' - VcoordName='high cld bot' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,pboth) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,pboth(isa,jsa) - -! retrieve time averaged high cloud top temperature using nemsio - VarName='tmp' - VcoordName='high cld top' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,Ttoph) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ',1,Ttoph(isa,jsa) - -! retrieve boundary layer cloud cover using nemsio - VarName='tcdc' - VcoordName='bndary-layer cld' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,pblcfr) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,pblcfr(isa,jsa) -! where (pblcfr /= spval)pblcfr=pblcfr/100. ! convert to fraction -!$omp parallel do private(i,j) - do j = jsta_2l, jend_2u - do i=1,im - if (pblcfr(i,j) < spval) pblcfr(i,j) = pblcfr(i,j) * 0.01 - enddo - enddo - -! retrieve cloud work function using nemsio - VarName='cwork' - VcoordName='atmos col' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,cldwork) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,cldwork(isa,jsa) - -! retrieve water runoff using nemsio - VarName='watr' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,runoff) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,runoff(isa,jsa) - -! retrieve shelter max temperature using nemsio - VarName='tmax' - VcoordName='2 m above gnd' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,maxtshltr) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,maxtshltr(isa,jsa) - -! retrieve shelter max temperature using nemsio - VarName='tmin' - VcoordName='2 m above gnd' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,mintshltr) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', & -! 1,mintshltr(im/2,(jsta+jend)/2) - -!$omp parallel do private(i,j) - do j=jsta_2l,jend_2u - do i=1,im - MAXRHSHLTR(i,j) = SPVAL - MINRHSHLTR(i,j) = SPVAL - enddo - enddo - -! retrieve ice thickness using nemsio - VarName='icetk' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dzice) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,dzice(isa,jsa) - -! retrieve wilting point using nemsio - VarName='wilt' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,smcwlt) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,smcwlt(isa,jsa) - -! retrieve sunshine duration using nemsio - VarName='sunsd' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,suntime) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,suntime(isa,jsa) - -! retrieve field capacity using nemsio - VarName='fldcp' - VcoordName='sfc' - l=1 - call getnemsandscatter(me,ffile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,fieldcapa) -! if(debugprint)print*,'sample l',VcoordName,VarName,' = ', 1,fieldcapa(isa,jsa) - -! GFS does not have deep convective cloud top and bottom fields - -!$omp parallel do private(i,j) - do j=jsta,jend - do i=1,im - HTOPD(i,j) = SPVAL - HBOTD(i,j) = SPVAL - HTOPS(i,j) = SPVAL - HBOTS(i,j) = SPVAL - CUPPT(i,j) = SPVAL - enddo - enddo - -! -!!!! DONE GETTING -! Will derive isobaric OMEGA from continuity equation later. -! OMGA=SPVAL -! -! -! retrieve d3d fields if it's listed -! ---------------------------------- - if (me == 0) print*,'iostatus for d3d file= ',iostatusD3D - if(iostatusD3D == 0) then ! start reading d3d file -! retrieve longwave tendency using getgb - Index=41 - VarName='LW RAD TEMP TNDY' - jpds=-1.0 - jgds=-1.0 - jpds(5)=251 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,rlwtt(1,jsta_2l,ll)) - end do - -! retrieve shortwave tendency using getgb - Index=40 - VarName='SW RAD TEMP TNDY' - jpds=-1.0 - jgds=-1.0 - jpds(5)=250 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,rswtt(1,jsta_2l,ll)) - end do - -! retrieve vertical diffusion tendency using getgb - Index=356 - VarName='VDIFF TNDY' - jpds=-1.0 - jgds=-1.0 - jpds(5)=246 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,vdifftt(1,jsta_2l,ll)) - end do - -! retrieve deep convective tendency using getgb - Index=79 - VarName='AVE CNVCT RN TMPTDY' - jpds=-1.0 - jgds=-1.0 - jpds(5)=242 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,tcucn(1,jsta_2l,ll)) - end do - -! retrieve shallow convective tendency using getgb - Index=358 - VarName='S CNVCT TNDY' - jpds=-1.0 - jgds=-1.0 - jpds(5)=244 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,tcucns(1,jsta_2l,ll)) - end do - -! retrieve grid scale latent heat tendency using getgb - Index=78 - VarName='AVE GRDSCL RN TMPTDY' - jpds=-1.0 - jgds=-1.0 - jpds(5)=241 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,train(1,jsta_2l,ll)) - end do - -! retrieve vertical diffusion moistening using getgb - Index=360 - VarName='Vertical diffusion moistening' - jpds=-1.0 - jgds=-1.0 - jpds(5)=249 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,vdiffmois(1,jsta_2l,ll)) - end do - -! retrieve deep convection moistening using getgb - Index=361 - VarName='deep convection moistening' - jpds=-1.0 - jgds=-1.0 - jpds(5)=243 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,dconvmois(1,jsta_2l,ll)) - end do - -! retrieve shallow convection moistening using getgb - Index=362 - VarName='shallow convection moistening' - jpds=-1.0 - jgds=-1.0 - jpds(5)=245 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,sconvmois(1,jsta_2l,ll)) - end do - -! retrieve non-radiation tendency using getgb - Index=363 - VarName='non-radiation tendency' - jpds=-1.0 - jgds=-1.0 - jpds(5)=173 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,nradtt(1,jsta_2l,ll)) - end do - -! retrieve Vertical diffusion of ozone using getgb - Index=364 - VarName='Vertical diffusion of ozone' - jpds=-1.0 - jgds=-1.0 - jpds(5)=174 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,o3vdiff(1,jsta_2l,ll)) - end do - -! retrieve ozone production using getgb - Index=365 - VarName='Ozone production' - jpds=-1.0 - jgds=-1.0 - jpds(5)=175 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,o3prod(1,jsta_2l,ll)) - end do - -! retrieve ozone tendency using getgb - Index=366 - VarName='Ozone tendency' - jpds=-1.0 - jgds=-1.0 - jpds(5)=188 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,o3tndy(1,jsta_2l,ll)) - end do - -! retrieve mass weighted PV using getgb - Index=367 - VarName='Mass weighted PV' - jpds=-1.0 - jgds=-1.0 - jpds(5)=139 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,mwpv(1,jsta_2l,ll)) - end do - -! retrieve OZONE TNDY using getgb - Index=368 - VarName='?' - jpds=-1.0 - jgds=-1.0 - jpds(5)=239 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,unknown(1,jsta_2l,ll)) - end do - -! retrieve vertical diffusion zonal acceleration - Index=369 - VarName='VDIFF Z ACCE' - jpds=-1.0 - jgds=-1.0 - jpds(5)=247 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,vdiffzacce(1,jsta_2l,ll)) - end do - -! retrieve gravity drag zonal acceleration - Index=370 - VarName='G DRAG Z ACCE' - jpds=-1.0 - jgds=-1.0 - jpds(5)=181 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,zgdrag(1,jsta_2l,ll)) - end do - -! retrieve convective U momemtum mixing - Index=371 - VarName='CNVCT U M MIX' - jpds=-1.0 - jgds=-1.0 - jpds(5)=183 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,cnvctummixing(1,jsta_2l,ll)) - end do - -! retrieve vertical diffusion meridional acceleration - Index=372 - VarName='VDIFF M ACCE' - jpds=-1.0 - jgds=-1.0 - jpds(5)=248 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,vdiffmacce(1,jsta_2l,ll)) - end do - -! retrieve gravity drag meridional acceleration - Index=373 - VarName='G DRAG M ACCE' - jpds=-1.0 - jgds=-1.0 - jpds(5)=182 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,mgdrag(1,jsta_2l,ll)) - end do - -! retrieve convective V momemtum mixing - Index=374 - VarName='CNVCT V M MIX' - jpds=-1.0 - jgds=-1.0 - jpds(5)=184 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,cnvctvmmixing(1,jsta_2l,ll)) - end do - -! retrieve nonconvective cloud fraction - Index=375 - VarName='N CNVCT CLD FRA' - jpds=-1.0 - jgds=-1.0 - jpds(5)=213 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,ncnvctcfrac(1,jsta_2l,ll)) - end do - -! retrieve convective upward mass flux - Index=391 - VarName='CNVCT U M FLX' - jpds=-1.0 - jgds=-1.0 - jpds(5)=202 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,cnvctumflx(1,jsta_2l,ll)) - end do - -! retrieve convective downward mass flux - Index=392 - VarName='CNVCT D M FLX' - jpds=-1.0 - jgds=-1.0 - jpds(5)=209 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,cnvctdmflx(1,jsta_2l,ll)) - end do - -! retrieve nonconvective detraintment flux - Index=393 - VarName='CNVCT DET M FLX' - jpds=-1.0 - jgds=-1.0 - jpds(5)=219 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,cnvctdetmflx(1,jsta_2l,ll)) - end do - -! retrieve cnvct gravity drag zonal acceleration - Index=394 - VarName='CNVCT G DRAG Z ACCE' - jpds=-1.0 - jgds=-1.0 - jpds(5)=196 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,cnvctzgdrag(1,jsta_2l,ll)) - end do - -! retrieve cnvct gravity drag meridional acceleration - Index=395 - VarName='CNVCT G DRAG M ACCE' - jpds=-1.0 - jgds=-1.0 - jpds(5)=197 - jpds(6)=109 - do l=1,lm - jpds(7)=l - ll=lm-l+1 !flip 3d fields to count from top down - call getgbandscatter(me,iunitd3d,im,jm,im_jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName & - ,jpds,jgds,kpds,cnvctmgdrag(1,jsta_2l,ll)) - end do - - call baclose(iunitd3d,status) - print*,'done reading D3D fields' - - end if ! end of d3d file read - ! -------------------- - print *,'after d3d files reading,mype=',me - -! Retrieve aer fields if it's listed (GOCART) - print *, 'iostatus for aer file=', iostatusAER - if(iostatusAER == 0) then ! start reading aer file - -! retrieve dust emission fluxes - do K = 1, nbin_du - if ( K == 1) VarName='DUEM001' - if ( K == 2) VarName='DUEM002' - if ( K == 3) VarName='DUEM003' - if ( K == 4) VarName='DUEM004' - if ( K == 5) VarName='DUEM005' - VcoordName='atmos col' - l=1 - call getnemsandscatter(me,rfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,duem(1,jsta_2l,K)) -! if(debugprint)print*,'sample ',VarName,' = ',duem(isa,jsa,k) - enddo - -! retrieve dust sedimentation fluxes - do K = 1, nbin_du - if ( K == 1) VarName='DUSD001' - if ( K == 2) VarName='DUSD002' - if ( K == 3) VarName='DUSD003' - if ( K == 4) VarName='DUSD004' - if ( K == 5) VarName='DUSD005' - VcoordName='atmos col' - l=1 - call getnemsandscatter(me,rfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dusd(1,jsta_2l,K)) -! if(debugprint)print*,'sample ',VarName,' = ',dusd(isa,jsa,k) - enddo - -! retrieve dust dry deposition fluxes - do K = 1, nbin_du - if ( K == 1) VarName='DUDP001' - if ( K == 2) VarName='DUDP002' - if ( K == 3) VarName='DUDP003' - if ( K == 4) VarName='DUDP004' - if ( K == 5) VarName='DUDP005' - VcoordName='atmos col' - l=1 - call getnemsandscatter(me,rfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dudp(1,jsta_2l,K)) - print *,'dudp,ck=',maxval(dudp(1:im,jsta:jend,k)), & - minval(dudp(1:im,jsta:jend,k)) -! if(debugprint)print*,'sample ',VarName,' = ',dudp(isa,jsa,k) - enddo - -! retrieve dust wet deposition fluxes - do K = 1, nbin_du - if ( K == 1) VarName='DUWT001' - if ( K == 2) VarName='DUWT002' - if ( K == 3) VarName='DUWT003' - if ( K == 4) VarName='DUWT004' - if ( K == 5) VarName='DUWT005' - VcoordName='atmos col' - l=1 - call getnemsandscatter(me,rfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,duwt(1,jsta_2l,K)) -! if(debugprint)print*,'sample ',VarName,' = ',duwt(isa,jsa,k) - enddo - -! retrieve sfc mass concentration - VarName='DUSMASS' - VcoordName='atmos col' - l=1 - call getnemsandscatter(me,rfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dusmass) -! if(debugprint)print*,'sample ',VarName,' = ',dusmass(isa,jsa) - -! retrieve col mass density - VarName='DUCMASS' - VcoordName='atmos col' - l=1 - call getnemsandscatter(me,rfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,ducmass) -! if(debugprint)print*,'sample ',VarName,' = ',ducmass(isa,jsa) - -! retrieve sfc mass concentration (pm2.5) - VarName='DUSMASS25' - VcoordName='atmos col' - l=1 - call getnemsandscatter(me,rfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,dusmass25) -! if(debugprint)print*,'sample ',VarName,' = ',dusmass25(isa,jsa) - -! retrieve col mass density (pm2.5) - VarName='DUCMASS25' - VcoordName='atmos col' - l=1 - call getnemsandscatter(me,rfile,im,jm,jsta,jsta_2l & - ,jend_2u,MPI_COMM_COMP,icnt,idsp,spval,VarName,VcoordName & - ,l,im,jm,nframe,ducmass25) -! if(debugprint)print*,'sample ',VarName,' = ',ducmass25(isa,jsa) - - if (me == 0) print *,'after aer files reading,mype=',me - end if ! end of aer file read - -! pos east - call collect_loc(gdlat,dummy) - if(me == 0)then - latstart = nint(dummy(1,1)*gdsdegr) - latlast = nint(dummy(im,jm)*gdsdegr) - print*,'laststart,latlast B bcast= ',latstart,latlast,'gdsdegr=',gdsdegr,& - 'dummy(1,1)=',dummy(1,1),dummy(im,jm),'gdlat=',gdlat(1,1) - end if - call mpi_bcast(latstart,1,MPI_INTEGER,0,mpi_comm_comp,irtn) - call mpi_bcast(latlast,1,MPI_INTEGER,0,mpi_comm_comp,irtn) - write(6,*) 'laststart,latlast,me A calling bcast=',latstart,latlast,me - call collect_loc(gdlon,dummy) - if(me == 0)then - lonstart = nint(dummy(1,1)*gdsdegr) - lonlast = nint(dummy(im,jm)*gdsdegr) - end if - call mpi_bcast(lonstart,1,MPI_INTEGER,0,mpi_comm_comp,irtn) - call mpi_bcast(lonlast, 1,MPI_INTEGER,0,mpi_comm_comp,irtn) - - write(6,*)'lonstart,lonlast A calling bcast=',lonstart,lonlast -! -! ncdump -h -!! -!! - write(6,*) 'filename in INITPOST=', filename,' is' - -! status=nf_open(filename,NF_NOWRITE,ncid) -! write(6,*) 'returned ncid= ', ncid -! status=nf_get_att_real(ncid,varid,'DX',tmp) -! dxval=int(tmp) -! status=nf_get_att_real(ncid,varid,'DY',tmp) -! dyval=int(tmp) -! status=nf_get_att_real(ncid,varid,'CEN_LAT',tmp) -! cenlat=int(1000.*tmp) -! status=nf_get_att_real(ncid,varid,'CEN_LON',tmp) -! cenlon=int(1000.*tmp) -! status=nf_get_att_real(ncid,varid,'TRUELAT1',tmp) -! truelat1=int(1000.*tmp) -! status=nf_get_att_real(ncid,varid,'TRUELAT2',tmp) -! truelat2=int(1000.*tmp) -! status=nf_get_att_real(ncid,varid,'MAP_PROJ',tmp) -! maptype=int(tmp) -! status=nf_close(ncid) - -! dxval=30000. -! dyval=30000. -! -! write(6,*) 'dxval= ', dxval -! write(6,*) 'dyval= ', dyval -! write(6,*) 'cenlat= ', cenlat -! write(6,*) 'cenlon= ', cenlon -! write(6,*) 'truelat1= ', truelat1 -! write(6,*) 'truelat2= ', truelat2 -! write(6,*) 'maptype is ', maptype -! - -! close up shop -! call ext_int_ioclose ( DataHandle, Status ) - -! generate look up table for lifted parcel calculations - - THL = 210. - PLQ = 70000. - pt_TBL = 10000. ! this is for 100 hPa added by Moorthi - - CALL TABLE(PTBL,TTBL,PT_TBL, & - RDQ,RDTH,RDP,RDTHE,PL,THL,QS0,SQS,STHE,THE0) - - CALL TABLEQ(TTBLQ,RDPQ,RDTHEQ,PLQ,THL,STHEQ,THE0Q) - -! -! - IF(ME == 0)THEN - WRITE(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' - WRITE(6,51) (SPL(L),L=1,LSM) - 50 FORMAT(14(F4.1,1X)) - 51 FORMAT(8(F8.1,1X)) - ENDIF -! -! COMPUTE DERIVED TIME STEPPING CONSTANTS. -! -!MEB need to get DT -! DT = 120. !MEB need to get DT -! NPHS = 4 !MEB need to get physics DT -! TPREC=float(ifhr) -!MEB need to get DT - -!how am i going to get this information? -! NPREC = INT(TPREC *TSPH+D50) -! NHEAT = INT(THEAT *TSPH+D50) -! NCLOD = INT(TCLOD *TSPH+D50) -! NRDSW = INT(TRDSW *TSPH+D50) -! NRDLW = INT(TRDLW *TSPH+D50) -! NSRFC = INT(TSRFC *TSPH+D50) -!how am i going to get this information? -! -! IF(ME == 0)THEN -! WRITE(6,*)' ' -! WRITE(6,*)'DERIVED TIME STEPPING CONSTANTS' -! WRITE(6,*)' NPREC,NHEAT,NSRFC : ',NPREC,NHEAT,NSRFC -! WRITE(6,*)' NCLOD,NRDSW,NRDLW : ',NCLOD,NRDSW,NRDLW -! ENDIF -! -! COMPUTE DERIVED MAP OUTPUT CONSTANTS. -!$omp parallel do private(l) - DO L = 1,LSM - ALSL(L) = LOG(SPL(L)) - END DO -! -!HC WRITE IGDS OUT FOR WEIGHTMAKER TO READ IN AS KGDSIN - if(me == 0)then - print*,'writing out igds' - igdout = 110 -! open(igdout,file='griddef.out',form='unformatted' -! + ,status='unknown') - if(maptype == 1)THEN ! Lambert conformal - WRITE(igdout)3 - WRITE(6,*)'igd(1)=',3 - WRITE(igdout)im - WRITE(igdout)jm - WRITE(igdout)LATSTART - WRITE(igdout)LONSTART - WRITE(igdout)8 - WRITE(igdout)CENLON - WRITE(igdout)DXVAL - WRITE(igdout)DYVAL - WRITE(igdout)0 - WRITE(igdout)64 - WRITE(igdout)TRUELAT2 - WRITE(igdout)TRUELAT1 - WRITE(igdout)255 - ELSE IF(MAPTYPE == 2)THEN !Polar stereographic - WRITE(igdout)5 - WRITE(igdout)im - WRITE(igdout)jm - WRITE(igdout)LATSTART - WRITE(igdout)LONSTART - WRITE(igdout)8 - WRITE(igdout)CENLON - WRITE(igdout)DXVAL - WRITE(igdout)DYVAL - WRITE(igdout)0 - WRITE(igdout)64 - WRITE(igdout)TRUELAT2 !Assume projection at +-90 - WRITE(igdout)TRUELAT1 - WRITE(igdout)255 - ! Note: The calculation of the map scale factor at the standard - ! lat/lon and the PSMAPF - ! Get map factor at 60 degrees (N or S) for PS projection, which will - ! be needed to correctly define the DX and DY values in the GRIB GDS - if (TRUELAT1 < 0.) THEN - LAT = -60. - else - LAT = 60. - end if - - CALL MSFPS (LAT,TRUELAT1*0.001,PSMAPF) - - ELSE IF(MAPTYPE == 3) THEN !Mercator - WRITE(igdout)1 - WRITE(igdout)im - WRITE(igdout)jm - WRITE(igdout)LATSTART - WRITE(igdout)LONSTART - WRITE(igdout)8 - WRITE(igdout)latlast - WRITE(igdout)lonlast - WRITE(igdout)TRUELAT1 - WRITE(igdout)0 - WRITE(igdout)64 - WRITE(igdout)DXVAL - WRITE(igdout)DYVAL - WRITE(igdout)255 - ELSE IF(MAPTYPE == 0 .OR. MAPTYPE == 203)THEN !A STAGGERED E-GRID - WRITE(igdout)203 - WRITE(igdout)im - WRITE(igdout)jm - WRITE(igdout)LATSTART - WRITE(igdout)LONSTART - WRITE(igdout)136 - WRITE(igdout)CENLAT - WRITE(igdout)CENLON - WRITE(igdout)DXVAL - WRITE(igdout)DYVAL - WRITE(igdout)64 - WRITE(igdout)0 - WRITE(igdout)0 - WRITE(igdout)0 - END IF - end if -! -! close all files -! - call nemsio_close(nfile,iret=status) - call nemsio_close(ffile,iret=status) - call nemsio_close(rfile,iret=status) -! call baclose(iunit,status) - - RETURN - END - - diff --git a/sorc/ncep_post.fd/INITPOST_NEMS_MPIIO.f b/sorc/ncep_post.fd/INITPOST_NEMS_MPIIO.f deleted file mode 100644 index 9aed1706b..000000000 --- a/sorc/ncep_post.fd/INITPOST_NEMS_MPIIO.f +++ /dev/null @@ -1,2464 +0,0 @@ -!> @file -! . . . -!> SUBPROGRAM: INITPOST INITIALIZE POST FOR RUN -!! PRGRMMR: Hui-Ya Chuang DATE: 2008-03-26 -!! -!! ABSTRACT: THIS ROUTINE INITIALIZES CONSTANTS AND -!! VARIABLES AT THE START OF AN NEMS MODEL OR POST -!! PROCESSOR RUN. -!! -!! REVISION HISTORY -!! 21-03-11 Bo Cui - change local arrays to dimension (im,jsta:jend) -!! -!! USAGE: CALL INITPOST_NEMS -!! INPUT ARGUMENT LIST: -!! NREC -!! NFILE -!! -!! OUTPUT ARGUMENT LIST: -!! NONE -!! -!! OUTPUT FILES: -!! NONE -!! -!! SUBPROGRAMS CALLED: -!! UTILITIES: -!! NONE -!! LIBRARY: -!! COMMON - CTLBLK -!! LOOKUP -!! SOILDEPTH -!! -!! -!! ATTRIBUTES: -!! LANGUAGE: FORTRAN -!! MACHINE : CRAY C-90 -!! - SUBROUTINE INITPOST_NEMS_MPIIO() - - use vrbls3d, only: t, q, uh, vh, q2, cwm, f_ice, f_rain, f_rimef, cfr, pint,& - pint, alpint, pmid, pmidv, zint, zmid, wh, rlwtt, rswtt,& - ttnd, tcucn, train, el_pbl, exch_h, omga - use vrbls2d, only: f, pd, fis, pblh, mixht, ustar, z0, ths, qs, twbs, qwbs, prec,& - acprec, cuprec,ancprc, lspa, sno, snoavg, psfcavg, t10avg, t10m, akhsavg, akmsavg,& - refd_max, w_up_max, w_dn_max, up_heli_max, si, cldefi, th10, q10, pshltr,& - tshltr, qshltr, maxtshltr, mintshltr, maxrhshltr, minrhshltr, akhs, akms, albase,& - albedo, czen, cfracl, cfracm, islope, cmc, grnflx, pctsno, soiltb, vegfrc,& - acfrcv, acfrst, ssroff, bgroff, czmean, mxsnal, radot, sigt4, tg, sr, cfrach,& - rlwin, rlwtoa, alwin, alwout, alwtoa, rswin, rswinc, rswout, aswin,aswout,& - aswtoa, sfcshx, sfclhx, subshx, snopcx, sfcuvx, potevp, ncfrcv, ncfrst, u10h,& - u10, v10h, v10, u10max, v10max, smstav, smstot, sfcevp, ivgtyp, acsnow, acsnom,& - sst, thz0, qz0, uz0, vz0, htop, isltyp, sfcexc, hbot, htopd, htops, cuppt, cprate,& - hbotd, hbots - use soil, only: sldpth, sh2o, smc, stc - use masks, only: lmv, lmh, htm, vtm, dx, dy, hbm2, gdlat, gdlon, sm, sice - use kinds, only: i_llong - use wrf_io_flags_mod, only: - use params_mod, only: pi, dtr, g, d608, rd - use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, qs0, sqs, sthe, the0,& - ttblq, rdpq, rdtheq, stheq, the0q - use ctlblk_mod, only: me, mpi_comm_comp, global, icnt, idsp, jsta, ihrst, imin, idat, sdat,& - ifhr, ifmin, filename, restrt, imp_physics, isf_surface_physics, icu_physics, jend,& - dt, spval, gdsdegr, grib, pdtop, pt, tmaxmin, nsoil, lp1, jend_m, nprec, nphs, avrain,& - avcnvc, ardlw, ardsw, asrfc, novegtype, spl, lsm, dtq2, tsrfc, trdlw, trdsw, theat, tclod,& - tprec, alsl, lm , im, jm, jsta_2l, jend_2u, ivegsrc, pthresh - use gridspec_mod, only: dyval, dxval, cenlat, cenlon, maptype, gridtype, latstart, latlast, latnw,& - latse, lonstart, lonlast, lonnw, lonse, latstartv, latlastv, cenlatv, lonstartv,& - lonlastv, cenlonv -! use nemsio_module, only: nemsio_gfile, nemsio_getfilehead, nemsio_close, nemsio_getheadvar - use nemsio_module_mpi - use upp_math, only: h2u -! -! INCLUDE/SET PARAMETERS. - implicit none -! - type(nemsio_gfile) :: nfile -! - INCLUDE "mpif.h" -! This version of INITPOST shows how to initialize, open, read from, and -! close a NetCDF dataset. In order to change it to read an internal (binary) -! dataset, do a global replacement of _ncd_ with _int_. - - character(len=8) :: VarName - character(len=8) :: VcoordName - integer :: Status - integer fldsize,fldst,recn - character startdate*19,SysDepInfo*80,cgar*1 - character startdate2(19)*4 -! -! NOTE: SOME INTEGER VARIABLES ARE READ INTO DUMMY ( A REAL ). THIS IS OK -! AS LONG AS REALS AND INTEGERS ARE THE SAME SIZE. -! -! ALSO, EXTRACT IS CALLED WITH DUMMY ( A REAL ) EVEN WHEN THE NUMBERS ARE -! INTEGERS - THIS IS OK AS LONG AS INTEGERS AND REALS ARE THE SAME SIZE. - LOGICAL RUNB,SINGLRST,SUBPOST,NEST,HYDRO - LOGICAL IOOMG,IOALL - logical, parameter :: debugprint = .false. - logical fliplayer ! whether or not to flip layer - logical :: convert_rad_to_deg=.false. -! logical global - CHARACTER*32 LABEL - CHARACTER*40 CONTRL,FILALL,FILMST,FILTMP,FILTKE,FILUNV & - , FILCLD,FILRAD,FILSFC - CHARACTER*4 RESTHR - CHARACTER FNAME*80,ENVAR*50,BLANK*4 - integer nfhour ! forecast hour from nems io file - INTEGER IDATE(8),JDATE(8) -! -! DECLARE VARIABLES. -! - REAL FACT,tsph,tstart - REAL RINC(5) - REAL ETA1(LM+1), ETA2(LM+1) - REAL GARB - REAL DUM1D (LM+1) - REAL DUMMY ( IM, JM ) -! REAL DUMMY2 ( IM, JM ) - real, allocatable :: fi(:,:,:) - integer ibuf(im,jsta_2l:jend_2u) - real buf(im,jsta_2l:jend_2u) - character*8,allocatable:: recname(:) - character*8,allocatable :: reclevtyp(:) - integer,allocatable:: reclev(:) - real, allocatable:: bufy(:) - real, allocatable:: glat1d(:),glon1d(:) - real, allocatable:: tmp(:) -!jw - integer ii,jj,js,je,jev,iyear,imn,iday,itmp,ioutcount,istatus, & - nsrfc,nrdlw,nrdsw,nheat,nclod, & - iunit,nrec,I,J,L, iret,nframe,impf,jmpf,nframed2, & - igdout,ll,n,im1,jm1,iim1 -! - DATA BLANK/' '/ -! -!*********************************************************************** -! START INIT HERE. -! - WRITE(6,*)'INITPOST: ENTER INITPOST' -! -! -! STEP 1. READ MODEL OUTPUT FILE -! -!*** -! LMH always = LM for sigma-type vert coord -! LMV always = LM for sigma-type vert coord - - do j = jsta_2l, jend_2u - do i = 1, im - LMV ( i, j ) = lm - LMH ( i, j ) = lm - end do - end do - -! HTM VTM all 1 for sigma-type vert coord - - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - HTM ( i, j, l ) = 1.0 - VTM ( i, j, l ) = 1.0 - end do - end do - end do - -! The end j row is going to be jend_2u for all variables except for V. - JS=JSTA_2L - JE=JEND_2U - IF (JEND_2U==JM) THEN - JEV=JEND_2U+1 - ELSE - JEV=JEND_2U - ENDIF -! sample print point - ii=(1+im)/2 - jj=(1+jm)/2 -! initialize nemsio using mpi io module - call nemsio_init() - call nemsio_open(nfile,trim(filename),'read',mpi_comm_comp,iret=status) - if ( Status /= 0 ) then - print*,'error opening ',fileName, ' Status = ', Status ; stop - endif - call nemsio_getfilehead(nfile,iret=status,nrec=nrec) - print*,'nrec=',nrec - allocate(recname(nrec),reclevtyp(nrec),reclev(nrec)) - call nemsio_getfilehead(nfile,iret=iret & - ,recname=recname ,reclevtyp=reclevtyp,reclev=reclev) - if (me == 0)then - do i=1,nrec - print *,'recname,reclevtyp,reclev=',trim(recname(i)),' ', & - trim(reclevtyp(i)),reclev(i) - end do - end if - -! get start date - idate=0 -! if (me == 0)then - call nemsio_getfilehead(nfile,iret=iret & - ,idate=idate(1:7),nfhour=nfhour,nframe=nframe) - - impf=im+nframe*2 - jmpf=jm+nframe*2 - print*,'nframe,impf,jmpf= ',nframe,impf,jmpf - allocate(glat1d(impf*jmpf),glon1d(impf*jmpf) ) - call nemsio_getfilehead(nfile,dx=glat1d & - ,dy=glon1d,iret=iret) - if(iret/=0)print*,'did not find dx dy' - do j=jsta,jend - do i=1,im - ! dummy(i,j) = glat1d((j-1)*impf+i+nframe) - ! dummy2(i,j) = glon1d((j-1)*impf+i+nframe) - dx(i,j)= glat1d((j-1)*impf+i+nframe) - dy(i,j)= glon1d((j-1)*impf+i+nframe) - end do - end do - deallocate(glat1d,glon1d) - print*,'idate before broadcast = ',(idate(i),i=1,7) -! end if !for me=0 -! call mpi_bcast(idate(1),7,MPI_INTEGER,0,mpi_comm_comp,iret) -! call mpi_bcast(nfhour,1,MPI_INTEGER,0,mpi_comm_comp,iret) -! call mpi_bcast(nframe,1,MPI_INTEGER,0,mpi_comm_comp,iret) - - IF(.not. global)THEN - impf=im+nframe*2 - jmpf=jm+nframe*2 - ELSE - impf=im+1 ! post cut im off because it's the same as i=1 but data from model is till im - jmpf=jm - END IF - print*,'impf,jmpf,nframe for reading fields = ',impf,jmpf,nframe - print*,'idate after broadcast = ',(idate(i),i=1,7) - print*,'nfhour = ',nfhour - !call mpi_scatterv(dummy(1,1),icnt,idsp,mpi_real & - ! ,dx(1,jsta),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) - !call mpi_scatterv(dummy2(1,1),icnt,idsp,mpi_real & - ! ,dy(1,jsta),icnt(me),mpi_real,0,MPI_COMM_COMP,iret) - - - iyear = idate(1) - imn = idate(2) ! ask Jun - iday = idate(3) ! ask Jun - ihrst = idate(4) - imin = idate(5) - jdate = 0 - idate = 0 -! -! read(startdate,15)iyear,imn,iday,ihrst,imin - 15 format(i4,1x,i2,1x,i2,1x,i2,1x,i2) - print*,'start yr mo day hr min =',iyear,imn,iday,ihrst,imin - print*,'processing yr mo day hr min=' & - ,idat(3),idat(1),idat(2),idat(4),idat(5) -! - idate(1) = iyear - idate(2) = imn - idate(3) = iday - idate(5) = ihrst - idate(6) = imin - SDAT(1) = imn - SDAT(2) = iday - SDAT(3) = iyear - jdate(1) = idat(3) - jdate(2) = idat(1) - jdate(3) = idat(2) - jdate(5) = idat(4) - jdate(6) = idat(5) -! - print *,' idate=',idate - print *,' jdate=',jdate -! CALL W3DIFDAT(JDATE,IDATE,2,RINC) -! ifhr=nint(rinc(2)) -! - CALL W3DIFDAT(JDATE,IDATE,0,RINC) -! - print *,' rinc=',rinc - ifhr=nint(rinc(2)+rinc(1)*24.) - print *,' ifhr=',ifhr - ifmin=nint(rinc(3)) -! if(ifhr /= nfhour)print*,'find wrong Model input file';stop - print*,' in INITPOST ifhr ifmin fileName=',ifhr,ifmin,fileName - -! Getting tstart - tstart=0. - print*,'tstart= ',tstart - -! Getiing restart - - RESTRT=.TRUE. ! set RESTRT as default -! call ext_int_get_dom_ti_integer(DataHandle,'RESTARTBIN',itmp -! + ,1,ioutcount,istatus) - -! IF(itmp < 1)THEN -! RESTRT=.FALSE. -! ELSE -! RESTRT=.TRUE. -! END IF - -! print*,'status for getting RESTARTBIN= ',istatus - -! print*,'Is this a restrt run? ',RESTRT - - IF(tstart > 1.0E-2)THEN - ifhr=ifhr+NINT(tstart) - rinc=0 - idate=0 - rinc(2)=-1.0*ifhr - call w3movdat(rinc,jdate,idate) - SDAT(1)=idate(2) - SDAT(2)=idate(3) - SDAT(3)=idate(1) - IHRST=idate(5) - print*,'new forecast hours for restrt run= ',ifhr - print*,'new start yr mo day hr min =',sdat(3),sdat(1) & - ,sdat(2),ihrst,imin - END IF - - VarName='mp_physi' - !if(me == 0)then - call nemsio_getheadvar(nfile,trim(VarName),imp_physics,iret) - if (iret /= 0) then - print*,VarName," not found in file- go to 16 character " - VarName='mp_physics' - call nemsio_getheadvar(nfile,trim(VarName),imp_physics,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned 1000" - imp_physics=1000 - end if - end if - !end if - !call mpi_bcast(imp_physics,1,MPI_INTEGER,0,mpi_comm_comp,iret) - print*,'MP_PHYSICS= ',imp_physics - -! Initializes constants for Ferrier microphysics - if(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95)then - CALL MICROINIT(imp_physics) - end if - - VarName='sf_surface_physi' - call nemsio_getheadvar(nfile,trim(VarName),iSF_SURFACE_PHYSICS,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned 2 for NOAH LSM as default" - iSF_SURFACE_PHYSICS=2 - end if - print*,'SF_SURFACE_PHYSICS= ',iSF_SURFACE_PHYSICS - -! IVEGSRC=1 for IGBP and 0 for USGS - VarName='IVEGSRC' - call nemsio_getheadvar(nfile,trim(VarName),IVEGSRC,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned 1 for IGBP as default" - IVEGSRC=1 - end if - print*,'IVEGSRC= ',IVEGSRC - -! set novegtype based on vegetation classification - if(ivegsrc==1)then - novegtype=20 - else if(ivegsrc==0)then - novegtype=24 - end if - print*,'novegtype= ',novegtype - - VarName='CU_PHYSICS' - call nemsio_getheadvar(nfile,trim(VarName),iCU_PHYSICS,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned 2 for BMJ as default" - iCU_PHYSICS=2 - end if - print*,'CU_PHYSICS= ',iCU_PHYSICS - - - allocate(bufy(jm)) - VarName='DX' -! if(me == 0)then -! call nemsio_getheadvar(nfile,trim(VarName),bufy,iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! dx=spval -! end if -! end if -! call mpi_bcast(bufy,jm,MPI_REAL,0,mpi_comm_comp,iret) -! do j=jsta,jend -! do i=1,im -! dx(i,j)=bufy(j) -! end do -! end do - if(debugprint)print*,'sample ',VarName,' = ',dx(im/2,(jsta+jend)/2) - - VarName='DY' -! if(me == 0)then -! call nemsio_getheadvar(nfile,trim(VarName),bufy,iret) -! if (iret /= 0) then -! print*,VarName," not found in file-Assigned missing values" -! dx=spval -! end if -! end if -! call mpi_bcast(bufy,jm,MPI_REAL,0,mpi_comm_comp,iret) -! do j=jsta,jend -! do i=1,im -! dy(i,j)=bufy(j) -! end do -! end do - if(debugprint)print*,'sample ',VarName,' = ',dy(im/2,(jsta+jend)/2) - deallocate(bufy) - - VarName='dt' - call nemsio_getheadvar(nfile,trim(VarName),garb,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned missing values" - dt=spval - else - dt=garb - end if - - VarName='dphd' - call nemsio_getheadvar(nfile,trim(VarName),garb,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned missing values" - dyval=spval - else - dyval=garb*gdsdegr - end if -! dyval=106 ! hard wire for AQ domain testing - - VarName='dlmd' - call nemsio_getheadvar(nfile,trim(VarName),garb,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned missing values" - dxval=spval - else - dxval=garb*gdsdegr - end if -! dxval=124 ! hard wire for AQ domain testing - - print*,'DX, DY, DT=',dxval,dyval,dt - - VarName='TPH0D' - call nemsio_getheadvar(nfile,trim(VarName),garb,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned missing values" - cenlat=spval - else - cenlat=nint(garb*gdsdegr) - end if - - VarName='TLM0D' - call nemsio_getheadvar(nfile,trim(VarName),garb,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned missing values" - cenlon=spval - else - if(grib=="grib2") then - cenlon=nint((garb+360.)*gdsdegr) - endif - end if - - varname='sg1' - call nemsio_getheadvar(nfile,trim(varname),eta1,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned missing values" - ETA1=SPVAL - end if - - varname='sg2' - call nemsio_getheadvar(nfile,trim(varname),eta2,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned missing values" - ETA2=SPVAL - end if - if(me==0)then - open(75,file='ETAPROFILE.txt',form='formatted', & - status='unknown') - DO L=1,lm+1 - write(75,1020)L, ETA1(lm+2-l), ETA2(lm+2-l) - END DO - 1020 format(I3,2E17.10) - close (75) - end if - - varname='pdtop' - call nemsio_getheadvar(nfile,trim(varname),pdtop,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned missing values" - pdtop=SPVAL - end if - - varname='pt' - call nemsio_getheadvar(nfile,trim(varname),pt,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned missing values" - pt=SPVAL - end if - print*,'PT, PDTOP= ',PT,PDTOP - - VarName='sldpth' - call nemsio_getheadvar(nfile,trim(varname),sldpth,iret) - print*,'SLDPTH= ',(SLDPTH(N),N=1,NSOIL) - -! set default to not empty buket - nprec=0 - nphs=0 - nclod=0 - nheat=0 - nrdlw=0 - nrdsw=0 - nsrfc=0 - - VarName='nprec' - call nemsio_getheadvar(nfile,trim(varname),nprec,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned zero" - end if - if(debugprint)print*,'sample ',VarName,' = ',nprec - - VarName='nphs' - call nemsio_getheadvar(nfile,trim(varname),nphs,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned zero" - end if - if(debugprint)print*,'sample ',VarName,' = ',nphs - - VarName='nclod' - call nemsio_getheadvar(nfile,trim(varname),nclod,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned zero" - end if - if(debugprint)print*,'sample ',VarName,' = ',nclod - - VarName='nheat' - call nemsio_getheadvar(nfile,trim(varname),nheat,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned zero" - end if - if(debugprint)print*,'sample ',VarName,' = ',nheat - - VarName='nrdlw' - call nemsio_getheadvar(nfile,trim(varname),nrdlw,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned zero" - end if - if(debugprint)print*,'sample ',VarName,' = ',nrdlw - - VarName='nrdsw' - call nemsio_getheadvar(nfile,trim(varname),nrdsw,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned zero" - end if - if(debugprint)print*,'sample ',VarName,' = ',nrdsw - - VarName='nsrfc' - call nemsio_getheadvar(nfile,trim(varname),nsrfc,iret) - if (iret /= 0) then - print*,VarName," not found in file-Assigned zero" - end if - if(debugprint)print*,'sample ',VarName,' = ',nsrfc - - IF(.not. global)THEN - maptype=205 ! for Arakawa-B grid - gridtype='B' - ELSE - maptype=0 ! for global NMMB on latlon grid - gridtype='A' ! will put wind on mass point for now to make regular latlon - END IF - print*,'maptype and gridtype= ',maptype,gridtype - - HBM2=1.0 - -! start reading nemsio files using parallel read - fldsize=(jend-jsta+1)*im - allocate(tmp(fldsize*nrec)) - print*,'allocate tmp successfully' - tmp=0. - call nemsio_denseread(nfile,1,im,jsta,jend,tmp,iret=iret) - if(iret/=0)then - print*,"fail to read nemsio file using mpi io read, stopping" - stop - end if - - varname='glat' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,gdlat) - - call collect_loc(gdlat,dummy) -! decides whether or not to convert to degree - if(me==0)then - if(maxval(abs(dummy))0. .and. gdlon(2,jsta)<0.)then - do j=jsta,jend - gdlon(1,j)=gdlon(1,j)-360.0 - end do - end if - end if - if(debugprint)print*,'sample ',VarName,' = ',(gdlon(i,(jsta+jend)/2),i=1,im,8) - if(debugprint)print*,'max min lon=',maxval(gdlon),minval(gdlon) - call collect_loc(gdlon,dummy) - if(me==0)then - if(grib=='grib2') then - if(dummy(1,1)<0) dummy(1,1)=dummy(1,1)+360. - if(dummy(im,jm)<0) dummy(im,jm)=dummy(im,jm)+360. - endif - lonstart=nint(dummy(1,1)*gdsdegr) - lonlast=nint(dummy(im,jm)*gdsdegr) - lonnw=nint(dummy(1,jm)*gdsdegr) - lonse=nint(dummy(im,1)*gdsdegr) -! dxval=nint((dummy(2,1)-dummy(1,1))*1000.) -! dxval=124 ! hard wire for AQ domain testing - if(mod(im,2)==0)then -! cenlon=nint((dummy(ii,jj)+dummy(ii+1,jj)+dummy(ii+1,jj+1)+dummy(ii,jj+1))/4.0*1000.) - else -! cenlon=nint(dummy(ii,jj)*1000.) - end if - end if - call mpi_bcast(lonstart,1,MPI_INTEGER,0,mpi_comm_comp,iret) - call mpi_bcast(lonlast,1,MPI_INTEGER,0,mpi_comm_comp,iret) -! call mpi_bcast(dxval,1,MPI_INTEGER,0,mpi_comm_comp,iret) -! call mpi_bcast(cenlon,1,MPI_INTEGER,0,mpi_comm_comp,iret) - write(6,*)'lonstart,lonlast A calling bcast=',lonstart,lonlast - print*,'dxval, cenlon= ',dxval, cenlon - - convert_rad_to_deg=.false. - varname='vlat' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,buf) - - if(debugprint)print*,'sample ',VarName,' = ',buf(im/2,(jsta+jend)/2) - if(debugprint)print*,'max min vlat=',maxval(buf),minval(buf) - call collect_loc(buf,dummy) - if(me==0)then - if(maxval(abs(dummy)) 27.0 .or. sfcevp(i,j)<1.0)print*, & -! 'bad vegtype=',i,j,sfcevp(i,j) -! end do -! end do - - where(sfcevp /= spval)IVGTYP=nint(sfcevp) - if(debugprint)print*,'sample ',VarName,' = ',IVGTYP(im/2,(jsta+jend)/2) - - sfcevp=spval - VarName='sltyp' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,sfcevp) ! temporary use sfcevp because it's real in nemsio - where(sfcevp /= spval)ISLTYP=nint(sfcevp) - if(debugprint)print*,'sample ',VarName,' = ',ISLTYP(im/2,(jsta+jend)/2) - - sfcevp=spval - VarName='sfcevp' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,sfcevp) - if(debugprint)print*,'sample ',VarName,' = ',sfcevp(im/2,(jsta+jend)/2) - - VarName='sfcexc' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,sfcexc) - if(debugprint)print*,'sample ',VarName,' = ',sfcexc(im/2,(jsta+jend)/2) - if(debugprint)print*,'MAX/MIN ',VarName,' = ' & - ,maxval(sfcexc),minval(sfcexc) - - VarName='acsnow' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,acsnow) - if(debugprint)print*,'sample ',VarName,' = ',acsnow(im/2,(jsta+jend)/2) - - VarName='acsnom' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,acsnom) - if(debugprint)print*,'sample ',VarName,' = ',acsnom(im/2,(jsta+jend)/2) - - VarName='tsea' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,sst) - if(debugprint)print*,'sample ',VarName,' = ',sst(im/2,(jsta+jend)/2) - -! VarName='EL_PBL' ! not in nems io yet - VarName='xlen_mix' - VcoordName='mid layer' - do l=1,lm -! ll=lm-l+1 - ll=l - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,ll,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,EL_PBL(1,jsta_2l,ll)) - if(debugprint)print*,'sample l ',VarName,' = ',ll,EL_PBL(im/2,(jsta+jend)/2,ll) - end do ! do loop for l - - VarName='exch_h' - VcoordName='mid layer' - do l=1,lm -! ll=lm-l+1 - ll=l - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,ll,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,exch_h(1,jsta_2l,ll)) - if(debugprint)print*,'sample l ',VarName,' = ',ll,exch_h(im/2,(jsta+jend)/2,ll) - end do ! do loop for l - - VarName='thz0' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,thz0) - if(debugprint)print*,'sample ',VarName,' = ',thz0(im/2,(jsta+jend)/2) - - VarName='qz0' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,qz0) - if(debugprint)print*,'sample ',VarName,' = ',qz0(im/2,(jsta+jend)/2) - - VarName='uz0' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,uz0) - if(debugprint)print*,'sample ',VarName,' = ',uz0(im/2,(jsta+jend)/2) - - VarName='vz0' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,vz0) - if(debugprint)print*,'sample ',VarName,' = ',vz0(im/2,(jsta+jend)/2) - -! -! Very confusing story ... -! -! Retrieve htop and hbot => They are named CNVTOP, CNVBOT in the model and -! with HBOTS,HTOPS (shallow conv) and HBOTD,HTOPD (deep conv) represent -! the 3 sets of convective cloud base/top arrays tied to the frequency -! that history files are written. -! -! IN THE *MODEL*, arrays HBOT,HTOP are similar to CNVTOP,CNVBOT but are -! used in radiation and are tied to the frequency of radiation updates. -! -! For historical reasons model arrays CNVTOP,CNVBOT are renamed HBOT,HTOP -! and manipulated throughout the post. - -! retrieve htop and hbot -! VarName='HTOP' - VarName='cnvtop' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,htop) - where(htop /= spval)htop=float(lm)-htop+1.0 -! where(htop /= spval .and. htop > lm)htop=lm*1.0 - if(debugprint)print*,'sample ',VarName,' = ',htop(im/2,(jsta+jend)/2) - -! VarName='HBOT' - VarName='cnvbot' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,hbot) - where(hbot /= spval)hbot=float(lm)-hbot+1.0 -! where(hbot /= spval .and. hbot > lm)hbot=lm*1.0 - if(debugprint)print*,'sample ',VarName,' = ',hbot(im/2,(jsta+jend)/2) - - VarName='htopd' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,htopd) - where(htopd /= spval)htopd=float(lm)-htopd+1.0 -! where(htopd /= spval .and. htopd > lm)htopd=lm*1.0 - if(debugprint)print*,'sample ',VarName,' = ',htopd(im/2,(jsta+jend)/2) - - VarName='hbotd' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,hbotd) - where(hbotd /= spval)hbotd=float(lm)-hbotd+1.0 -! where(hbotd /= spval .and. hbotd > lm)hbotd=lm*1.0 - if(debugprint)print*,'sample ',VarName,' = ',hbotd(im/2,(jsta+jend)/2) - - VarName='htops' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,htops) - where(htops /= spval)htops=float(lm)-htops+1.0 -! where(htops /= spval .and. htops > lm)htops=lm*1.0 - if(debugprint)print*,'sample ',VarName,' = ',htops(im/2,(jsta+jend)/2) - - VarName='hbots' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,hbots) - where(hbots /= spval)hbots=float(lm)-hbots+1.0 -! where(hbots /= spval .and. hbots > lm)hbots=lm*1.0 - if(debugprint)print*,'sample ',VarName,' = ',hbots(im/2,(jsta+jend)/2) - - VarName='cuppt' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,cuppt) - if(debugprint)print*,'sample ',VarName,' = ',cuppt(im/2,(jsta+jend)/2) - - VarName='cprate' - VcoordName='sfc' - l=1 - call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u & - ,l,nrec,fldsize,spval,tmp & - ,recname,reclevtyp,reclev,VarName,VcoordName & - ,cprate) - if(debugprint)print*,'sample ',VarName,' = ',cprate(im/2,(jsta+jend)/2) - - deallocate(tmp,recname,reclevtyp,reclev) -!!!! DONE GETTING - - do l = 1, lm - do j = jsta, jend - do i = 1, im - IF(ABS(T(I,J,L))>1.0E-3) & - OMGA(I,J,L) = -WH(I,J,L)*PMID(I,J,L)*G/ & - (RD*T(I,J,L)*(1.+D608*Q(I,J,L))) - - end do - end do - end do - write(0,*)' after OMGA' - - - THL=210. - PLQ=70000. - - CALL TABLE(PTBL,TTBL,PT, & - RDQ,RDTH,RDP,RDTHE,PL,THL,QS0,SQS,STHE,THE0) - - CALL TABLEQ(TTBLQ,RDPQ,RDTHEQ,PLQ,THL,STHEQ,THE0Q) - write(0,*)' after TABLEQ' - - -! -! - IF(ME==0)THEN - WRITE(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' - WRITE(6,51) (SPL(L),L=1,LSM) - 50 FORMAT(14(F4.1,1X)) - 51 FORMAT(8(F8.1,1X)) - ENDIF -! -! COMPUTE DERIVED TIME STEPPING CONSTANTS. -! -!MEB need to get DT -! DT = 120. !MEB need to get DT -! NPHS = 4 !MEB need to get physics DT - DTQ2 = DT * NPHS !MEB need to get physics DT - TSPH = 3600./DT !MEB need to get DT - - IF (PTHRESH>0.) THEN - PTHRESH=0.01*DTQ2/3.6E6 !-- Precip rate >= 0.01 mm/h -! PTHRESH=0.01*DTQ2/(3600.*39.37) !-- Precip rate >= 0.01 inches/h - ENDIF - - TSRFC=float(NSRFC)/TSPH - IF(NSRFC==0)TSRFC=float(ifhr) !in case buket does not get emptied - TRDLW=float(NRDLW)/TSPH - IF(NRDLW==0)TRDLW=float(ifhr) !in case buket does not get emptied - TRDSW=float(NRDSW)/TSPH - IF(NRDSW==0)TRDSW=float(ifhr) !in case buket does not get emptied - THEAT=float(NHEAT)/TSPH - IF(NHEAT==0)THEAT=float(ifhr) !in case buket does not get emptied - TCLOD=float(NCLOD)/TSPH - IF(NCLOD==0)TCLOD=float(ifhr) !in case buket does not get emptied - TPREC=float(NPREC)/TSPH - IF(NPREC==0)TPREC=float(ifhr) !in case buket does not get emptied -! TPREC=float(ifhr) - print*,'TSRFC TRDLW TRDSW THEAT TCLOD TPREC= ' & - ,TSRFC, TRDLW, TRDSW, THEAT, TCLOD, TPREC -!MEB need to get DT - -!how am i going to get this information? -! NPREC = INT(TPREC *TSPH+D50) -! NHEAT = INT(THEAT *TSPH+D50) -! NCLOD = INT(TCLOD *TSPH+D50) -! NRDSW = INT(TRDSW *TSPH+D50) -! NRDLW = INT(TRDLW *TSPH+D50) -! NSRFC = INT(TSRFC *TSPH+D50) -!how am i going to get this information? -! -! IF(ME==0)THEN -! WRITE(6,*)' ' -! WRITE(6,*)'DERIVED TIME STEPPING CONSTANTS' -! WRITE(6,*)' NPREC,NHEAT,NSRFC : ',NPREC,NHEAT,NSRFC -! WRITE(6,*)' NCLOD,NRDSW,NRDLW : ',NCLOD,NRDSW,NRDLW -! ENDIF -! -! COMPUTE DERIVED MAP OUTPUT CONSTANTS. - DO L = 1,LSM - ALSL(L) = ALOG(SPL(L)) - END DO - write(0,*)' after ALSL' -! -!HC WRITE IGDS OUT FOR WEIGHTMAKER TO READ IN AS KGDSIN - if(me==0)then - print*,'writing out igds' - igdout=110 -! open(igdout,file='griddef.out',form='unformatted' -! + ,status='unknown') - IF(MAPTYPE==203)THEN !A STAGGERED E-GRID - WRITE(igdout)203 - WRITE(igdout)im - WRITE(igdout)jm - WRITE(igdout)LATSTART - WRITE(igdout)LONSTART - WRITE(igdout)136 - WRITE(igdout)CENLAT - WRITE(igdout)CENLON - WRITE(igdout)DXVAL - WRITE(igdout)DYVAL - WRITE(igdout)64 - WRITE(igdout)0 - WRITE(igdout)0 - WRITE(igdout)0 - WRITE(igdout)LATLAST - WRITE(igdout)LONLAST - ELSE IF(MAPTYPE==205)THEN !A STAGGERED B-GRID - WRITE(igdout)205 - WRITE(igdout)im - WRITE(igdout)jm - WRITE(igdout)LATSTART - WRITE(igdout)LONSTART - WRITE(igdout)136 - WRITE(igdout)CENLAT - WRITE(igdout)CENLON - WRITE(igdout)DXVAL - WRITE(igdout)DYVAL - WRITE(igdout)64 - WRITE(igdout)LATLAST - WRITE(igdout)LONLAST - WRITE(igdout)0 - WRITE(igdout)0 - WRITE(igdout)0 - END IF - open(111,file='copygb_gridnav.txt',form='formatted' & - ,status='unknown') - IF(MAPTYPE==203)THEN !A STAGGERED E-GRID - write(111,1000) 2*IM-1,JM,LATSTART,LONSTART,CENLON, & - NINT(dxval*107.),NINT(dyval*110.),CENLAT,CENLAT - ELSE IF(MAPTYPE==205)THEN !A STAGGERED B-GRID - if(grib=="grib2") then - write(111,1000) IM,JM,LATSTART/1000,LONSTART/1000,CENLON/1000, & - NINT(dxval*107.)/1000,NINT(dyval*110.)/1000, & - CENLAT/1000,CENLAT/1000, & - LATLAST/1000,LONLAST/1000 - endif - END IF -1000 format('255 3 ',2(I4,x),I6,x,I7,x,'8 ',I7,x,2(I6,x),'0 64', & - 3(x,I6),x,I7) - close(111) -! - IF (MAPTYPE==205)THEN !A STAGGERED B-GRID - open(112,file='latlons_corners.txt',form='formatted' & - ,status='unknown') - if(grib=="grib2") then - write(112,1001)LATSTART/1000,(LONSTART/1000)-360000, & - LATSE/1000, & - LONSE/1000,LATNW/1000,LONNW/1000,LATLAST/1000, & - (LONLAST/1000)-360000 - endif -1001 format(4(I6,x,I7,x)) - close(112) - ENDIF - - end if - -! close all files - call nemsio_close(nfile,iret=status) - call nemsio_finalize() -! - write(0,*)'end of INIT_NEMS' - - RETURN - END diff --git a/sorc/ncep_post.fd/INITPOST_NMM.f b/sorc/ncep_post.fd/INITPOST_NMM.f deleted file mode 100644 index c673aa5fb..000000000 --- a/sorc/ncep_post.fd/INITPOST_NMM.f +++ /dev/null @@ -1,2643 +0,0 @@ -!> @file -! -!> SUBPROGRAM: INITPOST INITIALIZE POST FOR RUN -!! PRGRMMR: RUSS TREADON ORG: W/NP2 DATE: 93-11-10 -!! -!! ABSTRACT: THIS ROUTINE INITIALIZES CONSTANTS AND -!! VARIABLES AT THE START OF AN ETA MODEL OR POST -!! PROCESSOR RUN. -!! -!! THIS ROUTINE ASSUMES THAT INTEGERS AND REALS ARE THE SAME SIZE -!! -!! PROGRAM HISTORY LOG: -!! 93-11-10 RUSS TREADON - ADDED DOCBLOC -!! 98-05-29 BLACK - CONVERSION OF POST CODE FROM 1-D TO 2-D -!! 99-01 20 TUCCILLO - MPI VERSION -!! 01-10-25 H CHUANG - MODIFIED TO PROCESS HYBRID MODEL OUTPUT -!! 02-06-19 MIKE BALDWIN - WRF VERSION -!! 02-08-15 H CHUANG - UNIT CORRECTION AND GENERALIZE PROJECTION OPTIONS -!! 03-07-25 H CHUANG - MODIFIED TO PROCESS NMM WRF -!! 05-12-05 H CHUANG - ADD CAPABILITY TO OUTPUT OFF-HOUR FORECAST WHICH HAS -!! NO INPACTS ON ON-HOUR FORECAST -!! 21-03-11 Bo Cui - change local arrays to dimension (im,jsta:jend) -!! -!! USAGE: CALL INIT -!! INPUT ARGUMENT LIST: -!! NONE -!! -!! OUTPUT ARGUMENT LIST: -!! NONE -!! -!! OUTPUT FILES: -!! NONE -!! -!! SUBPROGRAMS CALLED: -!! UTILITIES: -!! NONE -!! LIBRARY: -!! COMMON - CTLBLK -!! LOOKUP -!! SOILDEPTH -!! -!! -!! ATTRIBUTES: -!! LANGUAGE: FORTRAN -!! MACHINE : CRAY C-90 -!! - SUBROUTINE INITPOST_NMM - - use vrbls3d, only: t, u, uh, v, vh, q, cwm, f_ice, f_rain, f_rimef, q,& - qqw, qqr, qqs, qqi, qqg, qqw, cwm , q2, wh, pint, alpint, pmid,& - omga, pmidv, zmid, rlwtt, rswtt, ttnd, tcucn, train, exch_h,& - el_pbl, cfr, zint, REF_10CM, qqni, qqnr, qrimef - use vrbls2d, only: fis, cfrach, cfracl, cfracm, u10h, u10, v10h, v10,th10,& - q10, tshltr, qshltr, pshltr, smstav, smstot, acfrcv, acfrst, ncfrcv,& - ncfrst, ssroff, bgroff, sfcevp, sfcexc, vegfrc, acsnow, acsnom,& - cmc, sst, mdltaux, mdltauy, thz0, qz0, uz0, vz0, qs, z0, pblh, mixht,& - ustar, akhs, akms, ths, prec, cuprec, acprec, ancprc, cprate, cuppt,& - lspa, cldefi, htop, hbot, htopd, czmean, rswout, rlwin, rlwtoa, sigt4,& - radot, aswin, aswout, alwin, alwout, alwtoa, aswtoa, hbotd, htops,& - hbots, sr, rswin, rswinc, czen, tg, soiltb, twbs, sfcshx, qwbs,& - sfclhx, grnflx, subshx, potevp, sno, si, pctsno, ivgtyp, isltyp,& - islope, albedo, albase, mxsnal, epsr, f, REFC_10CM, REFD_MAX, & - RSWTOA, SWUPT, ACSWUPT, SWDNT, ACSWDNT, CD10, CH10 - use soil, only: smc, sh2o, stc, sldpth, sllevel - use masks, only: lmv, lmh, htm, vtm, hbm2, sm, sice, gdlat, gdlon, dx, dy - use params_mod, only: tfrz, g, rd, d608, rtd, dtr, erad - use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl,& - qs0, sqs, sthe, the0, ttblq, rdpq, rdtheq, stheq, the0q - use ctlblk_mod, only: jsta, jend, nprec, jsta_2l, jend_2u, filename,& - datahandle, datestr, ihrst, imin, sdat, spval, imp_physics, pt,& - icu_physics, pdtop, nsoil, isf_surface_physics, jsta_m, jend_m,& - avrain, avcnvc, ardsw, ardlw, asrfc, me, mpi_comm_comp, nphs, spl,& - lsm, dt, dtq2,tsrfc, trdlw, trdsw, idat, ifhr, ifmin, restrt,& - theat, tclod, tprec, alsl, lm, im, jm , submodelname - use gridspec_mod, only: latstart, latlast, cenlat, lonstart, lonlast,& - cenlon, dxval, dyval, maptype, gridtype, truelat1, truelat2,& - psmapf -! use wrf_io_flags_mod -! - implicit none -! -! INCLUDE/SET PARAMETERS. -! - INCLUDE "mpif.h" -! -! This version of INITPOST shows how to initialize, open, read from, and -! close a NetCDF dataset. In order to change it to read an internal (binary) -! dataset, do a global replacement of _ncd_ with _int_. - real :: dcenlat, dcenlon - character(len=31) :: VarName - integer :: Status, cen1, cen2 - character startdate*19,SysDepInfo*80 -! -! NOTE: SOME INTEGER VARIABLES ARE READ INTO DUMMY ( A REAL ). THIS IS OK -! AS LONG AS REALS AND INTEGERS ARE THE SAME SIZE. -! -! ALSO, EXTRACT IS CALLED WITH DUMMY ( A REAL ) EVEN WHEN THE NUMBERS ARE -! INTEGERS - THIS IS OK AS LONG AS INTEGERS AND REALS ARE THE SAME SIZE. - CHARACTER*4 RESTHR - INTEGER IDATE(8),JDATE(8) - INTEGER :: i_parent_start, j_parent_start -! -! DECLARE VARIABLES. -! - REAL RINC(5) - REAL ETA1(LM), ETA2(LM) - REAL DUMMY ( IM, JM ) -! REAL DUMMY2 ( IM, JM ) - real, allocatable :: fi(:,:,:) - REAL DUM3D ( IM+1, JM+1, LM+1 ) - REAL DUM3D2 ( IM+1, JM+1, LM+1 ) -!mp - INTEGER IDUMMY ( IM, JM ) -! -!jw - integer ii,jj,js,je,jev,iyear,imn,iday,itmp,ioutcount,istatus, & - nsrfc,nrdlw,nrdsw,nheat,nclod, & - I,J,L,LL,N,LONEND,LATEND,IMM,INAV,IRTN, & - IFDX,IFDY,IGDOUT,ICEN,JCEN -! integer iw, ie - real TSPH,fact,dumcst,tstart,tmp - real LAT -! -! Declarations for : -! putting 10 m wind on V points because copygb assume such - INTEGER IE, IW -!code from R.Rozumalski - INTEGER latnm, latsm, lonem, lonwm, idxave, dlat, dlon, nlat, nlon - -!*********************************************************************** -! START INIT HERE. -! - WRITE(6,*)'INITPOST: ENTER INITPOST' - print*,'im,jm,lm= ',im,jm,lm - - ii=im/2 ! diagnostic print indices - jj=(jsta+jend)/2 - ll=lm/2 -! -! STEP 1. READ MODEL OUTPUT FILE -! -! -!*** -! -! set default to not empty buket - NSRFC=0 - NRDLW=0 - NRDSW=0 - NHEAT=0 - NCLOD=0 - NPREC=0 - -! LMH always = LM for sigma-type vert coord -! LMV always = LM for sigma-type vert coord - - do j = jsta_2l, jend_2u - do i = 1, im - LMV ( i, j ) = lm - LMH ( i, j ) = lm - end do - end do - - -! HTM VTM all 1 for sigma-type vert coord - - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - HTM ( i, j, l ) = 1.0 - VTM ( i, j, l ) = 1.0 - end do - end do - end do -! -! how do I get the filename? -! fileName = '/ptmp/wx20mb/wrfout_01_030500' -! DateStr = '2002-03-05_18:00:00' -! how do I get the filename? - call ext_ncd_ioinit(SysDepInfo,Status) - print*,'called ioinit', Status - call ext_ncd_open_for_read( trim(fileName), 0, 0, " ", & - DataHandle, Status) - print*,'called open for read', Status - if ( Status /= 0 ) then - print*,'error opening ',fileName, ' Status = ', Status ; stop - endif -! get date/time info -! this routine will get the next time from the file, not using it - print *,'DateStr before calling ext_ncd_get_next_time=',DateStr -! call ext_ncd_get_next_time(DataHandle, DateStr, Status) - print *,'DateStri,Status,DataHandle = ',DateStr,Status,DataHandle - -! The end j row is going to be jend_2u for all variables except for V. - JS=JSTA_2L - JE=JEND_2U - IF (JEND_2U==JM) THEN - JEV=JEND_2U+1 - ELSE - JEV=JEND_2U - ENDIF -! -! Getting start time - call ext_ncd_get_dom_ti_char(DataHandle,'START_DATE',startdate, & - status ) -! patch for NMM WRF because it does not have start-date in output yet -! startdate='2003-04-17T00:00:00' - print*,'startdate= ',startdate -! - jdate=0 - idate=0 - read(startdate,15)iyear,imn,iday,ihrst,imin - 15 format(i4,1x,i2,1x,i2,1x,i2,1x,i2) - print*,'start yr mo day hr min =',iyear,imn,iday,ihrst,imin - print*,'processing yr mo day hr min=',idat(3),idat(1),idat(2), & - idat(4),idat(5) - idate(1)=iyear - idate(2)=imn - idate(3)=iday - idate(5)=ihrst - idate(6)=imin - SDAT(1)=imn - SDAT(2)=iday - SDAT(3)=iyear -! - jdate(1)=idat(3) - jdate(2)=idat(1) - jdate(3)=idat(2) - jdate(5)=idat(4) - jdate(6)=idat(5) -! CALL W3DIFDAT(JDATE,IDATE,2,RINC) -! ifhr=nint(rinc(2)) - CALL W3DIFDAT(JDATE,IDATE,0,RINC) - ifhr=nint(rinc(2)+rinc(1)*24.) - ifmin=nint(rinc(3)) - print*,' in INITPOST ifhr ifmin fileName=',ifhr,ifmin,fileName - -! Getting tstart - call ext_ncd_get_dom_ti_real(DataHandle,'TSTART',tmp,1,ioutcount, & - istatus) - if(istatus==0)then - tstart=tmp - else - tstart=0. - end if - print*,'status for getting TSTART= ',istatus - print*,'TSTART= ',TSTART - -! Getting restart - - RESTRT=.TRUE. ! set RESTRT default - call ext_ncd_get_dom_ti_integer(DataHandle,'RESTARTBIN',itmp,1, & - ioutcount,istatus) - - IF(itmp < 1)THEN - RESTRT=.FALSE. - ELSE - RESTRT=.TRUE. - END IF - - print*,'status for getting RESTARTBIN= ',istatus - print*,'Is this a restrt run? ',RESTRT - -! IF(RESTRT)THEN -! ifhr=ifhr+NINT(tstart) -! print*,'new forecast hours for restrt run= ',ifhr -! END IF - - IF(tstart > 1.0E-2)THEN - ifhr=ifhr+NINT(tstart) - rinc=0 - idate=0 - rinc(2)=-1.0*ifhr - call w3movdat(rinc,jdate,idate) - SDAT(1)=idate(2) - SDAT(2)=idate(3) - SDAT(3)=idate(1) - IHRST=idate(5) - print*,'new forecast hours for restrt run= ',ifhr - print*,'new start yr mo day hr min =',sdat(3),sdat(1), & - sdat(2),ihrst,imin - END IF - - VarName='HBM2' - HBM2=SPVAL - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - HBM2 ( i, j ) = dummy ( i, j ) - end do - end do - -! OK, since all of the variables are dimensioned/allocated to be -! the same size, this means we have to be careful int getVariable -! to not try to get too much data. For example, -! DUM3D is dimensioned IM+1,JM+1,LM+1 but there might actually -! only be im,jm,lm points of data available for a particular variable. - -! get 3-D variables - VarName='T' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - t ( i, j, l ) = dum3d ( i, j, l ) -! if(l==1)print*,'Debug: I,J,T= ',i,j,t ( i, j, l ) -! t ( i, j, l ) = dum3d ( i, j, l ) + 300. -! th ( i, j, l ) = dum3d ( i, j, l ) + 300. - end do - end do - end do - do l=1,lm - if(jj>= jsta .and. jj<=jend)print*,'sample L,T= ',L,T(ii,jj,l) - end do - -! VarName='T_ADJ' -! call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, -! & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) -! do l = 1, lm -! do j = jsta_2l, jend_2u -! do i = 1, im -! t_ADJ ( i, j, l ) = dum3d ( i, j, l ) -! end do -! end do -! end do -! do l=1,lm -! if(jj>= jsta .and. jj<=jend)print*,'sample L,T_ADJ= ',L -! &,T_ADJ(ii,jj,l) -! end do - - - VarName='U' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - u ( i, j, l ) = dum3d ( i, j, l ) - UH( i, j, l ) = dum3d ( i, j, l ) -! if(l==1)print*,'Debug: I,J,U= ',i,j,u( i, j, l ) - end do - end do -! fill up UH which is U at P-points including 2 row halo -! do j = jsta_2l, jend_2u -! do i = 1, im -! UH (I,J,L) = (dum3d(I,J,L)+dum3d(I+1,J,L))*0.5 -! end do -! end do - end do - if(jj>= jsta .and. jj<=jend)print*,'sample U= ',U(ii,jj,ll) - VarName='V' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - v ( i, j, l ) = dum3d ( i, j, l ) - VH( i, j, l ) = dum3d ( i, j, l ) - end do - end do -! fill up VH which is V at P-points including 2 row halo -! do j = jsta_2l, jend_2u -! do i = 1, im -! VH(I,J,L) = (dum3d(I,J,L)+dum3d(I,J+1,L))*0.5 -! end do -! end do - end do - if(jj>= jsta .and. jj<=jend)print*,'sample V= ',V(ii,jj,ll) - - call ext_ncd_get_dom_ti_integer(DataHandle,'MP_PHYSICS' & - ,itmp,1,ioutcount,istatus) - imp_physics=itmp -! Chuang: will initialize microphysics constants differently for 85 now -! if(imp_physics == 85) imp_physics=5 !HWRF - print*,'MP_PHYSICS= ',imp_physics - -! Initializes constants for Ferrier microphysics - if(imp_physics==5 .or. imp_physics==15 .or. imp_physics==85 & - .or. imp_physics==95)then - CALL MICROINIT(imp_physics) - end if - - call ext_ncd_get_dom_ti_integer(DataHandle,'CU_PHYSICS' & - ,itmp,1,ioutcount,istatus) - icu_physics=itmp - if (icu_physics == 84 .or. icu_physics == 85) icu_physics = 4 ! HWRF - print*,'CU_PHYSICS= ',icu_physics - - ! Set these values to SPVAL to insure they are initialized a - ! fact that the code relies on later.... - qqw=spval - qqr=spval - qqs=spval - qqi=spval - qqg=spval - -!KRF: NMM and ARW direct read of radar ref for microphysic options -! mp options: 2,4,6,7,8,10,14,16 -! REFL_10cm --> REF_10CM -! REFD_MAX --> REFD_MAX - VarName='REFL_10CM' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - REF_10CM ( i, j, l ) = dum3d ( i, j, l ) - end do - end do - end do - do l=1,lm - if(jj>= jsta .and. jj<=jend)print*,'sample L,T= ',L,T(ii,jj,l) - end do - - VarName='REFD_MAX' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - REFD_MAX ( i, j ) = dummy ( i, j ) - end do - end do -! print*,'REFD_MAX at ',ii,jj,' = ',REFD_MAX(ii,jj) -! END KRF - - if(imp_physics==5 .or. imp_physics==15 .or. imp_physics==85 .or. imp_physics==95)then - - VarName='Q' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - if (dum3d(i,j,l) < 10E-12) dum3d(i,j,l) = 10E-12 - q ( i, j, l ) = dum3d ( i, j, l ) - end do - end do - end do - print*,'finish reading specific humidity' - if(jj>= jsta .and. jj<=jend)print*,'sample Q= ',Q(ii,jj,ll) - - else - VarName='QVAPOR' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im -! q ( i, j, l ) = dum3d ( i, j, l ) -! if(l==1)print*,'Debug: I,J,Q= ',i,j,q( i, j, l ) -!CHC CONVERT MIXING RATIO TO SPECIFIC HUMIDITY - if (dum3d(i,j,l) < 10E-12) dum3d(i,j,l) = 10E-12 - q ( i, j, l ) = dum3d ( i, j, l )/(1.0+dum3d ( i, j, l )) - end do - end do - end do - print*,'finish reading specific humidity' - if(jj>= jsta .and. jj<=jend)print*,'sample Q= ',Q(ii,jj,ll) - endif - - if(imp_physics==5 .or. imp_physics==85 .or. imp_physics==95)then - VarName='CWM' !????? - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - cwm ( i, j, l ) = dum3d ( i, j, l ) - end do - end do - end do - print*,'finish reading cloud mixing ratio' - - VarName='F_ICE' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - F_ICE ( i, j, l ) = dum3d ( i, j, l ) - end do - end do - end do - - VarName='F_RAIN' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - F_RAIN ( i, j, l ) = dum3d ( i, j, l ) - end do - end do - end do - - VarName='F_RIMEF' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - F_RIMEF ( i, j, l ) = dum3d ( i, j, l ) - end do - end do - end do - - else ! retrieve hydrometeo fields directly for non-Ferrier - cwm=spval !make sure set - F_RimeF=spval !make sure set - - if(imp_physics/=0)then - VarName='QCLOUD' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im -! partition cloud water and ice for WSM3 - if(imp_physics==3)then - if(t(i,j,l) >= TFRZ)then - qqw ( i, j, l ) = dum3d ( i, j, l ) - else - qqi ( i, j, l ) = dum3d ( i, j, l ) - end if - else ! bug fix provided by J CASE - qqw ( i, j, l ) = dum3d ( i, j, l ) - end if - cwm(i,j,l)=dum3d(i,j,l) - end do - end do - end do - end if - if(jj>= jsta .and. jj<=jend)print*,'sample qqw= ' & - ,Qqw(ii,jj,ll) - - if(imp_physics/=1 .and. imp_physics/=3 & - .and. imp_physics/=0)then - VarName='QICE' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - qqi ( i, j, l ) = dum3d ( i, j, l ) - cwm(i,j,l)=cwm(i,j,l)+dum3d(i,j,l) - end do - end do - end do - end if - if(jj>= jsta .and. jj<=jend)print*,'sample qqi= ' & - ,Qqi(ii,jj,ll) - - if(imp_physics==15) then - VarName='QRIMEF' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - qrimef ( i, j, l ) = dum3d ( i, j, l ) - end do - end do - end do - end if - if(jj>= jsta .and. jj<=jend)print*,'sample qrimef= ' & - ,Qrimef(ii,jj,ll) - - if(imp_physics/=0)then - VarName='QRAIN' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im -! partition rain and snow for WSM3 - if(imp_physics == 3)then - if(t(i,j,l) >= TFRZ)then - qqr ( i, j, l ) = dum3d ( i, j, l ) - else - qqs ( i, j, l ) = dum3d ( i, j, l ) - end if - else ! bug fix provided by J CASE - qqr ( i, j, l ) = dum3d ( i, j, l ) - end if - cwm(i,j,l)=cwm(i,j,l)+dum3d(i,j,l) - end do - end do - end do - end if - if(jj>= jsta .and. jj<=jend)print*,'sample qqr= ' & - ,Qqr(ii,jj,ll) - - if(imp_physics/=1 .and. imp_physics/=3 & - .and. imp_physics/=0)then - VarName='QSNOW' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - qqs ( i, j, l ) = dum3d ( i, j, l ) - cwm(i,j,l)=cwm(i,j,l)+dum3d(i,j,l) - end do - end do - end do - end if - if(jj>= jsta .and. jj<=jend)print*,'sample qqs= ' & - ,Qqs(ii,jj,ll) - - if(imp_physics==2 .or. imp_physics==6 & - .or. imp_physics==8 .or. imp_physics==28)then - VarName='QGRAUP' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - qqg ( i, j, l ) = dum3d ( i, j, l ) - cwm(i,j,l)=cwm(i,j,l)+dum3d(i,j,l) - end do - end do - end do - end if - if(jj>= jsta .and. jj<=jend)print*,'sample qqg= ' & - ,Qqg(ii,jj,ll) - -! KRS: Add concentrations for HWRF output - if(imp_physics==8 .or. imp_physics==9)then - VarName='QNICE' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM, JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - qqni ( i, j, l ) = dum3d ( i, j, l ) - if(i==im/2.and.j==(jsta+jend)/2)print*,'sample QQNI= ', & - i,j,l,QQNI ( i, j, l ) - end do - end do - end do - VarName='QNRAIN' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM, JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - qqnr ( i, j, l ) = dum3d ( i, j, l ) - if(i==im/2.and.j==(jsta+jend)/2)print*,'sample QQNR= ', & - i,j,l,QQNR ( i, j, l ) - end do - end do - end do - end if -! KRS: End add concentrations for HWRF - - end if ! end of retrieving hydrometeo for different MP options - - -! call getVariable(fileName,DateStr,DataHandle,'TKE_PBL',DUM3D, - call getVariable(fileName,DateStr,DataHandle,'Q2',DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - q2 ( i, j, l ) = dum3d ( i, j, l ) - end do - end do - end do - VarName='W' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM+1) -! & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) -! do l = 1, lm+1 -! do j = jsta_2l, jend_2u -! do i = 1, im -! w ( i, j, l ) = dum3d ( i, j, l ) -! end do -! end do -! end do -! fill up WH which is W at P-points including 2 row halo - DO L=1,LM - DO I=1,IM - DO J=JSTA_2L,JEND_2U -! WH(I,J,L) = (W(I,J,L)+W(I,J,L+1))*0.5 - wh ( i, j, l ) = dum3d ( i, j, l+1 ) - ENDDO - ENDDO - ENDDO - print*,'finish reading W' - -!MEB call getVariable(fileName,DateStr,DataHandle,'QRAIN',new) - - VarName='PINT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM+1) -! VarName='P' -! call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D2, -! & IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm+1 - do j = jsta_2l, jend_2u - do i = 1, im -! PMID(I,J,L)=DUM3D(I,J,L)+DUM3D2(I,J,L) - PINT(I,J,L)=DUM3D(I,J,L) - ALPINT(I,J,L)=ALOG(PINT(I,J,L)) - end do - end do - end do -! do l = 1, lm+1 -! if(jj>= jsta .and. jj<=jend)print*,'sample PINT= ' -! & ,PINT(ii,jj,l) -! end do -! - DO L=1,LM - DO I=1,IM - DO J=JSTA_2L,JEND_2U - PMID(I,J,L)=(PINT(I,J,L)+PINT(I,J,L+1))*0.5 -! TH(I,J,L)=T(I,J,L)*(1.E5/PMID(I,J,L))**CAPA - IF(ABS(T(I,J,L))>1.0E-3) & - OMGA(I,J,L) = -WH(I,J,L)*PMID(I,J,L)*G/ & - (RD*T(I,J,L)*(1.+D608*Q(I,J,L))) -! -! PINT(I,J,L)=EXP((ALOG(PMID(I,J,L-1))+ -! & ALOG(PMID(I,J,L)))*0.5) ! ave of ln p -! ALPINT(I,J,L)=ALOG(PINT(I,J,L)) - ENDDO - ENDDO - ENDDO -! - do l = 1, lm - do j = jsta, jend - do i = 1, im-MOD(J,2) - IF(J == 1 .AND. I < IM)THEN !SOUTHERN BC - PMIDV(I,J,L)=0.5*(PMID(I,J,L)+PMID(I+1,J,L)) - ELSE IF(J==JM .AND. I1.0e-5)print*,'nonzero ncfrcv',ncfrcv(i,j) - end do - end do - - VarName='NCFRST' - write(6,*) 'call getIVariable for : ', VarName - call getIVariableN(fileName,DateStr,DataHandle,VarName,IDUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ncfrst ( i, j ) = float(idummy ( i, j )) -! if(ncfrst(i,j)>1.0e-5)print*,'nonzero ncfrst',ncfrst(i,j) - end do - end do - - VarName='SSROFF' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SSROFF ( i, j ) = dummy ( i, j ) - end do - end do - VarName='UDROFF' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - BGROFF ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='SFCEVP' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SFCEVP( i, j ) = dummy ( i, j ) - end do - end do -! print*,'SFCEVP at ',ii,jj,' = ',SFCEVP(ii,jj) - - VarName='CD10' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY,& - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - CD10( i, j ) = dummy ( i, j ) - end do - end do -! print*,'CD10 at ',ii,jj,' = ',CD10(ii,jj) - - VarName='CH10' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY,& - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - CH10( i, j ) = dummy ( i, j ) - end do - end do -! print*,'CD10 at ',ii,jj,' = ',CD10(ii,jj) - - VarName='SFCEXC' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SFCEXC( i, j ) = dummy ( i, j ) - end do - end do -! print*,'SFCEXC at ',ii,jj,' = ',SFCEXC(ii,jj) - VarName='VEGFRC' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - VEGFRC ( i, j ) = dummy ( i, j ) - end do - end do - print*,'VEGFRC at ',ii,jj,' = ',VEGFRC(ii,jj) - VarName='ACSNOW' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ACSNOW ( i, j ) = dummy ( i, j ) - end do - end do - VarName='ACSNOM' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ACSNOM ( i, j ) = dummy ( i, j ) - end do - end do -! VarName='CANWAT' - VarName='CMC' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - CMC ( i, j ) = dummy ( i, j ) - end do - end do - VarName='SST' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SST ( i, j ) = dummy ( i, j ) - end do - end do - print*,'SST at ',ii,jj,' = ',sst(ii,jj) - - VarName='TAUX' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - MDLTAUX ( i, j ) = dummy ( i, j ) - end do - end do - print*,'MDLTAUX at ',ii,jj,' = ',mdltaux(ii,jj) - - VarName='TAUY' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - MDLTAUY ( i, j ) = dummy ( i, j ) - end do - end do - print*,'MDLTAUY at ',ii,jj,' = ',mdltauy(ii,jj) - - VarName='EXCH_H' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - EXCH_H ( i, j, l ) = dum3d ( i, j, l ) - dummy(i,j)=dum3d ( i, j, l ) - end do - end do - print*,'l, max exch = ',l,maxval(dummy) - end do - do l=1,lm - print*,'sample EXCH_H= ',EXCH_H(ii,jj,l) - end do - - VarName='EL_PBL' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - EL_PBL ( i, j, l ) = dum3d ( i, j, l ) - dummy(i,j)=dum3d ( i, j, l ) - end do - end do - print*,'l, max EL_PBL = ',l,maxval(dummy) - end do - - - VarName='THZ0' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - THZ0 ( i, j ) = dummy ( i, j ) - end do - end do - print*,'THZ0 at ',ii,jj,' = ',THZ0(ii,jj) - VarName='QZ0' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - QZ0 ( i, j ) = dummy ( i, j ) - end do - end do - print*,'QZ0 at ',ii,jj,' = ',QZ0(ii,jj) - VarName='UZ0' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - UZ0 ( i, j ) = dummy ( i, j ) - end do - end do - print*,'UZ0 at ',ii,jj,' = ',UZ0(ii,jj) - VarName='VZ0' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - VZ0 ( i, j ) = dummy ( i, j ) - end do - end do - print*,'VZ0 at ',ii,jj,' = ',VZ0(ii,jj) -! VarName='QSFC' - VarName='QS' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - QS ( i, j ) = dummy ( i, j ) -! if(qs(i,j)>1.0e-7)print*,'nonzero qsfc' - end do - end do - - VarName='Z0' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - Z0 ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='PBLH' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - PBLH( i, j ) = dummy ( i, j ) - end do - end do -! write(6,*) 'PBLH(ii,jj): ', DUMMY(ii,jj) - - VarName='MIXHT' !PLee (3/07) - MIXHT=SPVAL !Init value to detect read failure - call getVariable(filename,DateStr,DataHandle,Varname,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - MIXHT( i, j ) = dummy ( i, j ) - end do - end do - - VarName='USTAR' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - USTAR( i, j ) = dummy ( i, j ) - end do - end do - - print*,'USTAR at ',ii,jj,' = ',USTAR(ii,jj) - VarName='AKHS_OUT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - AKHS ( i, j ) = dummy ( i, j ) - end do - end do - print*,'max akhs= ',maxval(akhs) - VarName='AKMS_OUT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - AKMS ( i, j ) = dummy ( i, j ) - end do - end do - print*,'max akms= ',maxval(akms) - -! -! In my version, variable is TSK (skin temp, not skin pot temp) -! -!mp call getVariable(fileName,DateStr,DataHandle,'THSK',DUMMY, -! VarName='TSK' - VarName='THS' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - THS ( i, j ) = dummy ( i, j ) - end do - end do - print*,'THS at ',ii,jj,' = ',THS(ii,jj) - -!C -!CMP -!C -!C RAINC is "ACCUMULATED TOTAL CUMULUS PRECIPITATION" -!C RAINNC is "ACCUMULATED TOTAL GRID SCALE PRECIPITATION" - - write(6,*) 'getting RAINC' - - VarName='PREC' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im -! CUPREC ( i, j ) = dummy ( i, j ) * 0.001 - PREC ( i, j ) = dummy ( i, j ) - end do - end do - print*,'PREC at ',ii,jj,' = ',PREC(ii,jj) - -! VarName='RAINC' - VarName='CUPREC' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im -! CUPREC ( i, j ) = dummy ( i, j ) * 0.001 - CUPREC ( i, j ) = dummy ( i, j ) - end do - end do - print*,'CUPREC at ',ii,jj,' = ',CUPREC(ii,jj) - write(6,*) 'getting RAINTOTAL' -! VarName='RAINNC' - VarName='ACPREC' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ACPREC( i, j ) = dummy ( i, j ) - ANCPRC ( i, j ) = ACPREC(I,J)-CUPREC(I,J) - end do - end do - print*,'ACPREC at ',ii,jj,' = ',ACPREC(ii,jj) - print*,'ANCPRC at ',ii,jj,' = ',ANCPRC(ii,jj) -! -! hoping to read instantanous convective precip rate soon, initialize it to spval -! for now - - VarName='CPRATE' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - CPRATE(I,J)=dummy(i,j) - enddo - enddo - - VarName='CUPPT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - CUPPT ( i, j ) = dummy ( i, j ) - end do - end do - print*,'maxval CUPPT: ', maxval(DUMMY) - -! adding land surface precipitation accumulation for Yin's precip assimilation - - VarName='LSPA' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - LSPA ( i, j ) = dummy ( i, j ) - end do - end do - print*,'maxval LSPA: ', maxval(DUMMY) - - - VarName='CLDEFI' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - CLDEFI ( i, j ) = dummy ( i, j ) - end do - end do - print*,'maxval CLDEFI: ', maxval(DUMMY) - -! -! Very confusing story ... -! -! Retrieve htop and hbot => They are named CNVTOP, CNVBOT in the model and -! with HBOTS,HTOPS (shallow conv) and HBOTD,HTOPD (deep conv) represent -! the 3 sets of convective cloud base/top arrays tied to the frequency -! that history files are written. -! -! IN THE *MODEL*, arrays HBOT,HTOP are similar to CNVTOP,CNVBOT but are -! used in radiation and are tied to the frequency of radiation updates. -! -! For historical reasons model arrays CNVTOP,CNVBOT are renamed HBOT,HTOP -! and manipulated throughout the post. - -! VarName='HTOP' - VarName='CNVTOP' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - HTOP ( i, j ) = float(LM)-dummy(i,j)+1.0 - HTOP ( i, j ) = max(1.0,min(HTOP(I,J),float(LM))) - end do - end do - print*,'maxval HTOP: ', maxval(DUMMY) - -! VarName='HBOT' - VarName='CNVBOT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - HBOT ( i, j ) = float(LM)-dummy(i,j)+1.0 - HBOT ( i, j ) = max(1.0,min(HBOT(I,J),float(LM))) - end do - end do - print*,'maxval HBOT: ', maxval(DUMMY) - - VarName='HTOPD' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - HTOPD ( i, j ) = float(LM)-dummy(i,j)+1.0 - end do - end do - print*,'maxval HTOPD: ', maxval(DUMMY) - - VarName='HBOTD' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - HBOTD ( i, j ) = float(LM)-dummy(i,j)+1.0 - end do - end do - print*,'maxval HBOTD: ', maxval(DUMMY) - - VarName='HTOPS' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - HTOPS ( i, j ) = float(LM)-dummy(i,j)+1.0 - end do - end do - print*,'maxval HTOPS: ', maxval(DUMMY) - - VarName='HBOTS' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - HBOTS ( i, j ) = float(LM)-dummy(i,j)+1.0 - end do - end do - print*,'maxval HBOTS: ', maxval(DUMMY) - - VarName='CLDFRA' - call getVariable(fileName,DateStr,DataHandle,VarName,DUM3D, & - IM+1,1,JM+1,LM+1,IM,JS,JE,LM) - do l = 1, lm - do j = jsta_2l, jend_2u - do i = 1, im - CFR ( i, j, l ) = dum3d ( i, j, l ) - end do - end do - end do - - - VarName='SR' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SR ( i, j ) = dummy(i,j) - end do - end do - print*,'maxval SR: ', maxval(DUMMY) - -! call getVariable(fileName,DateStr,DataHandle,'RAINCV',DUMMY, -! & IM,1,JM,1,IM,JS,JE,1) -! do j = jsta_2l, jend_2u -! do i = 1, im -! CUPPT ( i, j ) = dummy ( i, j )* 0.001 -! end do -! end do -! -! VarName='GSW' - VarName='RSWIN' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - RSWIN ( i, j ) = dummy ( i, j ) -! if(abs(dummy(i,j))> 0.0)print*,'rswin=',dummy(i,j) - end do - end do - - VarName='RSWINC' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - RSWINC ( i, j ) = dummy ( i, j ) -! if(abs(dummy(i,j))> 0.0)print*,'rswin=',dummy(i,j) - end do - end do - -! read in zenith angle - VarName='CZEN' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - CZEN ( i, j ) = dummy ( i, j ) -! if(abs(czen(i,j))> 0.0)print*,'czen=',czen(i,j) - end do - end do - - VarName='CZMEAN' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - CZMEAN ( i, j ) = dummy ( i, j ) -! if(abs(dummy(i,j))> 0.0)print*,'czmean=',dummy(i,j) - end do - end do - - VarName='RSWOUT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - RSWOUT ( i, j ) = dummy ( i, j ) -! if(abs(dummy(i,j))> 0.0)print*,'rswout=',dummy(i,j) - end do - end do - -! VarName='GLW' - VarName='RLWIN' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - RLWIN ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='RLWTOA' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - RLWTOA ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='SIGT4' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SIGT4 ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='RADOT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - RADOT ( i, j ) = dummy ( i, j ) - end do - end do - -! accumulated incoming short wave - VarName='ASWIN' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ASWIN ( i, j ) = dummy ( i, j ) - end do - end do - -! accumulated outgoing short wave - VarName='ASWOUT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ASWOUT ( i, j ) = dummy ( i, j ) -! if(abs(dummy(i,j))> 0.0)print*,'aswout=',dummy(i,j) - end do - end do - -! shortwave accumulation frequency - VarName='NRDSW' - call getIVariableN(fileName,DateStr,DataHandle,VarName,NRDSW, & - 1,1,1,1,1,1,1,1) - print*,'NRDSW in INITPOST_NMM=',NRDSW - - VarName='ARDSW' - call getVariable(fileName,DateStr,DataHandle,VarName,ARDSW, & - 1,1,1,1,1,1,1,1) - print*,'ARDSW ARDLW in INITPOST_NMM=',ARDSW, ARDLW -! accumulated incoming long wave - VarName='ALWIN' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ALWIN ( i, j ) = dummy ( i, j ) - end do - end do - -! accumulated outgoing long wave - VarName='ALWOUT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ALWOUT ( i, j ) = dummy ( i, j ) - end do - end do - -! longwave accumulation frequency - VarName='NRDLW' - call getIVariableN(fileName,DateStr,DataHandle,VarName,NRDLW, & - 1,1,1,1,1,1,1,1) - print*,'NRDLW= ',NRDLW - -! longwave accumulation counts - VarName='ARDLW' - call getVariable(fileName,DateStr,DataHandle,VarName,ARDLW, & - 1,1,1,1,1,1,1,1) - -! obtain time averaged radition at the top of atmosphere - VarName='ALWTOA' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ALWTOA ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='ASWTOA' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ASWTOA ( i, j ) = dummy ( i, j ) - end do - end do - -! KRS: Add RSWTOA to radiation variable options - VarName='RSWTOA' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - RSWTOA ( i, j ) = dummy ( i, j ) - end do - end do - -! KRS: RRTMG variables for HWRF - VarName='SWUPT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SWUPT ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='ACSWUPT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ACSWUPT ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='SWDNT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SWDNT ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='ACSWDNT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ACSWDNT ( i, j ) = dummy ( i, j ) - end do - end do - -! END KRS RRTMG Vars - - -! VarName='TMN' -! VarName='TG' - VarName='TGROUND' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - TG ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='SOILTB' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SOILTB ( i, j ) = dummy ( i, j ) - end do - end do - -! sensible heat fluxes - VarName='TWBS' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - TWBS ( i, j ) = dummy ( i, j ) - end do - end do - -! accumulated sensible heat fluxes -! VarName='HFX' - VarName='SFCSHX' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SFCSHX ( i, j ) = dummy ( i, j ) - end do - end do - -! fluxes accumulation frequency - VarName='NSRFC' - call getIVariableN(fileName,DateStr,DataHandle,VarName,NSRFC, & - 1,1,1,1,1,1,1,1) - print*,'NSRFC= ',NSRFC -! fluxes accumulation counts - VarName='ASRFC' - call getVariable(fileName,DateStr,DataHandle,VarName,ASRFC, & - 1,1,1,1,1,1,1,1) - -! instantanous latent heat fluxes - VarName='QWBS' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - QWBS ( i, j ) = dummy ( i, j ) - end do - end do - -! accumulated latent heat fluxes -! VarName='QFX' - VarName='SFCLHX' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SFCLHX ( i, j ) = dummy ( i, j ) - end do - end do - -! instantanous ground heat fluxes - VarName='GRNFLX' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - GRNFLX ( i, j ) = dummy ( i, j ) - end do - end do - -! accumulated ground heat fluxes - VarName='SUBSHX' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SUBSHX ( i, j ) = dummy ( i, j ) - end do - end do - -! accumulated ground heat fluxes - VarName='POTEVP' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - POTEVP ( i, j ) = dummy ( i, j ) - end do - end do - -! VarName='SNOWC' -! VarName='SNO' - VarName='WEASD' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) -! do j = jsta_2l, jend_2u -! do i = 1, im -! SNO ( i, j ) = dummy ( i, j ) -! end do -! end do - - VarName='SNO' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SNO ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='SI' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SI ( i, j ) = dummy ( i, j ) - end do - end do - -! snow cover - VarName='PCTSNO' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - PCTSNO ( i, j ) = dummy ( i, j ) - if(dummy(i,j) > 1.0e-5)print*,'nonzero pctsno' - end do - end do - - -! GET VEGETATION TYPE - -! call getVariable(fileName,DateStr,DataHandle,'IVGTYP',DUMMY -! & ,IM,1,JM,1,IM,JS,JE,1) -! print*,'sample VEG TYPE',DUMMY(20,20) -! XLAND 1 land 2 sea -! VarName='XLAND' - - VarName='IVGTYP' - call getIVariableN(fileName,DateStr,DataHandle,VarName,IDUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - IVGTYP ( i, j ) = idummy ( i, j ) - end do - end do - print*,'MAX IVGTYP=', maxval(idummy) - - VarName='ISLTYP' - call getIVariableN(fileName,DateStr,DataHandle,VarName,IDUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ISLTYP ( i, j ) = idummy ( i, j ) - end do - end do - print*,'MAX ISLTYP=', maxval(idummy) - - VarName='ISLOPE' - call getIVariableN(fileName,DateStr,DataHandle,VarName,IDUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ISLOPE( i, j ) = idummy ( i, j ) - end do - end do - - VarName='SM' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SM ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='SICE' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - SICE ( i, j ) = dummy ( i, j ) - end do - end do - - VarName='ALBEDO' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ALBEDO( i, j ) = dummy ( i, j ) - end do - end do - - VarName='ALBASE' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - ALBASE( i, j ) = dummy ( i, j ) - end do - end do - - VarName='MXSNAL' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - MXSNAL( i, j ) = dummy ( i, j ) - end do - end do - - VarName='EPSR' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - EPSR( i, j ) = dummy ( i, j ) - end do - end do - -! VarName='XLAT' - VarName='GLAT' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - f(i,j) = 1.454441e-4*sin(dummy(i,j)) - GDLAT ( i, j ) = dummy ( i, j ) * RTD - end do - end do -! pos north - print*,'GDLAT at ',ii,jj,' = ',GDLAT(ii,jj) - print*,'read past GDLAT' -! VarName='XLONG' - VarName='GLON' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - GDLON ( i, j ) = dummy ( i, j ) * RTD -! if(j==1 .or. j==jm)print*,'I,J,GDLON,GDLAT= ',i,j -! 1 ,GDLON( i, j ),GDLAT ( i, j ) -! if(abs(GDLAT(i,j)-20.0)<0.5 .and. abs(GDLON(I,J) -! 1 +157.0)<5.)print* -! 2 ,'Debug:I,J,GDLON,GDLAT,SM,HGT,psfc= ',i,j,GDLON(i,j) -! 3 ,GDLAT(i,j),SM(i,j),FIS(i,j)/G,PINT(I,j,lm+1) - end do - end do - print*,'GDLON at ',ii,jj,' = ',GDLON(ii,jj) - print*,'read past GDLON' -! pos east - call collect_loc(gdlat,dummy) - get_dcenlat: if(me==0)then - latstart=nint(dummy(1,1)*1000.) ! lower left - latlast=nint(dummy(im,jm)*1000.) ! upper right - - icen=im/2 !center grid - jcen=jm/2 -print *, 'dummy(icen,jcen) = ', dummy(icen,jcen) -print *, 'dummy(icen-1,jcen) = ', dummy(icen-1,jcen) -print *, 'dummy(icen+1,jcen) = ', dummy(icen+1,jcen) - - ! Grid navigation for copygb - R.Rozumalski - latnm = nint(dummy(icen,jm)*1000.) - latsm = nint(dummy(icen,1)*1000.) -print *, 'latnm, latsm', latnm, latsm - - ! temporary patch for nmm wrf for moving nest - ! cenlat = glat(im/2,jm/2) -Gopal - - if(mod(im,2)/=0)then !per Pyle, jm is always odd - if(mod(jm+1,4)/=0)then - dcenlat=dummy(icen,jcen) - else - dcenlat=0.5*(dummy(icen-1,jcen)+dummy(icen,jcen)) - end if - else - if(mod(jm+1,4)/=0)then - dcenlat=0.5*(dummy(icen,jcen)+dummy(icen+1,jcen)) - else - dcenlat=dummy(icen,jcen) - end if - end if - endif get_dcenlat - write(6,*) 'laststart,latlast,dcenlat B calling bcast= ', & - latstart,latlast,dcenlat - call mpi_bcast(latstart,1,MPI_INTEGER,0,mpi_comm_comp,irtn) - call mpi_bcast(latlast,1,MPI_INTEGER,0,mpi_comm_comp,irtn) - call mpi_bcast(dcenlat,1,MPI_REAL,0,mpi_comm_comp,irtn) - write(6,*) 'laststart,latlast A calling bcast= ',latstart,latlast - - call collect_loc(gdlon,dummy) - get_dcenlon: if(me==0)then - lonstart=nint(dummy(1,1)*1000.) - lonlast=nint(dummy(im,jm)*1000.) - - ! icen, jcen set above -print *, 'lon dummy(icen,jcen) = ', dummy(icen,jcen) -print *, 'lon dummy(icen-1,jcen) = ', dummy(icen-1,jcen) -print *, 'lon dummy(icen+1,jcen) = ', dummy(icen+1,jcen) - - ! Grid navigation for copygb - R.Rozumalski - lonem = nint(dummy(icen,jm)*1000.) - lonwm = nint(dummy(icen,1)*1000.) - - if(mod(im,2)/=0)then !per Pyle, jm is always odd - if(mod(jm+1,4)/=0)then - cen1=dummy(icen,jcen) - cen2=cen1 - else - cen1=min(dummy(icen-1,jcen),dummy(icen,jcen)) - cen2=max(dummy(icen-1,jcen),dummy(icen,jcen)) - end if - else - if(mod(jm+1,4)/=0)then - cen1=min(dummy(icen+1,jcen),dummy(icen,jcen)) - cen2=max(dummy(icen+1,jcen),dummy(icen,jcen)) - else - cen1=dummy(icen,jcen) - cen2=cen1 - end if - end if - ! Trahan fix: Pyle's code broke at the dateline. - if(cen2-cen1>180) then - ! We're near the dateline - dcenlon=mod(0.5*(cen2+cen1+360)+3600+180,360.)-180. - else - ! We're not near the dateline. Use the original code, - ! unmodified, to maintain bitwise identicality. - dcenlon=0.5*(cen1+cen2) - endif - end if get_dcenlon ! rank 0 - write(6,*)'lonstart,lonlast,cenlon B calling bcast= ',lonstart, & - lonlast,cenlon - call mpi_bcast(lonstart,1,MPI_INTEGER,0,mpi_comm_comp,irtn) - call mpi_bcast(lonlast,1,MPI_INTEGER,0,mpi_comm_comp,irtn) - call mpi_bcast(dcenlon,1,MPI_REAL,0,mpi_comm_comp,irtn) - write(6,*)'lonstart,lonlast,cenlon A calling bcast= ',lonstart, & - lonlast,cenlon - - if(me==0) then - open(1013,file='this-domain-center.ksh.inc',form='formatted',status='unknown') -1013 format(A,'=',F0.3) - write(1013,1013) 'clat',dcenlat - write(1013,1013) 'clon',dcenlon - endif -! -! OBTAIN DX FOR NMM WRF - VarName='DX_NMM' - call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, & - IM,1,JM,1,IM,JS,JE,1) - do j = jsta_2l, jend_2u - do i = 1, im - DX ( i, j ) = dummy ( i, j ) - if(DX(i,j)<0.1)print*,'zero dx in INIT: I,J,DX= ',i,j & - ,DX( i, j ) -! if(j==1 .or. j==jm)print*,'I,J,DX= ',i,j -! 1 ,DX( i, j ) - end do - end do - - varname='ETA1' - write(6,*) 'call getVariable for : ', VarName - call getVariable(fileName,DateStr,DataHandle,VarName,ETA1, & - LM,1,1,1,LM,1,1,1) - - varname='ETA2' - write(6,*) 'call getVariable for : ', VarName - call getVariable(fileName,DateStr,DataHandle,VarName,ETA2, & - LM,1,1,1,LM,1,1,1) - - open(75,file='ETAPROFILE.txt',form='formatted',status='unknown') - DO L=1,lm+1 - IF(L == 1)THEN - write(75,1020)L, 0., 0. - ELSE - write(75,1020)L, ETA1(lm+2-l), ETA2(lm+2-l) - END IF -! print*,'L, ETA1, ETA2= ',L, ETA1(l), ETA2(l) - END DO - 1020 format(I3,2E17.10) - close (75) - -! physics calling frequency - VarName='NPHS0' - call getIVariableN(fileName,DateStr,DataHandle,VarName,NPHS, & - 1,1,1,1,1,1,1,1) - print*,'NPHS= ',NPHS -! physics calling frequency - VarName='NCLOD' - call getIVariableN(fileName,DateStr,DataHandle,VarName,NCLOD, & - 1,1,1,1,1,1,1,1) - -! physics calling frequency - VarName='NPREC' - call getIVariableN(fileName,DateStr,DataHandle,VarName,NPREC, & - 1,1,1,1,1,1,1,1) - -! physics calling frequency - VarName='NHEAT' - call getIVariableN(fileName,DateStr,DataHandle,VarName,NHEAT, & - 1,1,1,1,1,1,1,1) - print*,'NHEAT= ',NHEAT - - ! Compute f_* arrays from q* arrays - if(imp_physics==15) then - print *,'Convert from Q arrays to F arrays for advected Ferrier.' - call etamp_q2f(QRIMEF,QQI,QQR,QQW,CWM,F_RAIN,F_ICE,F_RIMEF,T) - endif -! -! ncdump -h - -!! -!! -!! - write(6,*) 'filename in INITPOST=', filename,' is' - -! status=nf_open(filename,NF_NOWRITE,ncid) -! write(6,*) 'returned ncid= ', ncid -! status=nf_get_att_real(ncid,varid,'DX',tmp) -! dxval=int(tmp) -! status=nf_get_att_real(ncid,varid,'DY',tmp) -! dyval=int(tmp) -! status=nf_get_att_real(ncid,varid,'CEN_LAT',tmp) -! cenlat=int(1000.*tmp) -! status=nf_get_att_real(ncid,varid,'CEN_LON',tmp) -! cenlon=int(1000.*tmp) -! status=nf_get_att_real(ncid,varid,'TRUELAT1',tmp) -! truelat1=int(1000.*tmp) -! status=nf_get_att_real(ncid,varid,'TRUELAT2',tmp) -! truelat2=int(1000.*tmp) -! status=nf_get_att_real(ncid,varid,'MAP_PROJ',tmp) -! maptype=int(tmp) -! status=nf_close(ncid) - -! dxval=30000. -! dyval=30000. -! -! write(6,*) 'dxval= ', dxval -! write(6,*) 'dyval= ', dyval -! write(6,*) 'cenlat= ', cenlat -! write(6,*) 'cenlon= ', cenlon -! write(6,*) 'truelat1= ', truelat1 -! write(6,*) 'truelat2= ', truelat2 -! write(6,*) 'maptype is ', maptype -! - call ext_ncd_get_dom_ti_real(DataHandle,'DX',tmp, & - 1,ioutcount,istatus) - dxval=nint(tmp*1000.) ! E-grid dlamda in degree - write(6,*) 'dxval= ', dxval - - call ext_ncd_get_dom_ti_real(DataHandle,'DY',tmp, & - 1,ioutcount,istatus) - dyval=nint(tmp*1000.) - write(6,*) 'dyval= ', dyval - - call ext_ncd_get_dom_ti_real(DataHandle,'CEN_LAT',tmp, & - 1,ioutcount,istatus) - cenlat=nint(tmp*1000.) ! E-grid dlamda in degree - write(6,*) 'cenlat= ', cenlat - - call ext_ncd_get_dom_ti_real(DataHandle,'CEN_LON',tmp, & - 1,ioutcount,istatus) - cenlon=nint(tmp*1000.) ! E-grid dlamda in degree - write(6,*) 'cenlon= ', cenlon - -! JW call ext_ncd_get_dom_ti_real(DataHandle,'TRUELAT1',tmp -! JW + ,1,ioutcount,istatus) -! JW truelat1=nint(1000.*tmp) -! JW write(6,*) 'truelat1= ', truelat1 -! JW call ext_ncd_get_dom_ti_real(DataHandle,'TRUELAT2',tmp -! JW + ,1,ioutcount,istatus) -! JW truelat2=nint(1000.*tmp) -! JW write(6,*) 'truelat2= ', truelat2 - call ext_ncd_get_dom_ti_integer(DataHandle,'MAP_PROJ',itmp, & - 1,ioutcount,istatus) - maptype=itmp - gridtype = 'E' - write(6,*) 'maptype, gridtype ', maptype, gridtype - gridtype='E' - - call ext_ncd_get_dom_ti_integer(DataHandle,'I_PARENT_START',itmp, & - 1,ioutcount,istatus) - i_parent_start=itmp - - call ext_ncd_get_dom_ti_integer(DataHandle,'J_PARENT_START',itmp, & - 1,ioutcount,istatus) - j_parent_start=itmp - - do j = jsta_2l, jend_2u - do i = 1, im -! DX ( i, j ) = dxval - DY ( i, j ) = dyval*DTR*ERAD*0.001 - end do - end do - -! generate look up table for lifted parcel calculations - - THL=210. - PLQ=70000. - - CALL TABLE(PTBL,TTBL,PT, & - RDQ,RDTH,RDP,RDTHE,PL,THL,QS0,SQS,STHE,THE0) - - CALL TABLEQ(TTBLQ,RDPQ,RDTHEQ,PLQ,THL,STHEQ,THE0Q) - -! -! - IF(ME==0)THEN - WRITE(6,*)' SPL (POSTED PRESSURE LEVELS) BELOW: ' - WRITE(6,51) (SPL(L),L=1,LSM) - 50 FORMAT(14(F4.1,1X)) - 51 FORMAT(8(F8.1,1X)) - ENDIF -! -! COMPUTE DERIVED TIME STEPPING CONSTANTS. -! - call ext_ncd_get_dom_ti_real(DataHandle,'DT',tmp, & - 1,ioutcount,istatus) - DT=tmp - print*,'DT= ',DT - DTQ2 = DT * NPHS - TSPH = 3600./DT - - TSRFC=float(NSRFC)/TSPH - IF(NSRFC==0)TSRFC=float(ifhr) !in case buket does not get emptied - TRDLW=float(NRDLW)/TSPH - IF(NRDLW==0)TRDLW=float(ifhr) !in case buket does not get emptied - TRDSW=float(NRDSW)/TSPH - IF(NRDSW==0)TRDSW=float(ifhr) !in case buket does not get emptied - THEAT=float(NHEAT)/TSPH - IF(NHEAT==0)THEAT=float(ifhr) !in case buket does not get emptied - TCLOD=float(NCLOD)/TSPH - IF(NCLOD==0)TCLOD=float(ifhr) !in case buket does not get emptied - TPREC=float(NPREC)/TSPH - IF(NPREC==0)TPREC=float(ifhr) !in case buket does not get emptied - print*,'TSRFC TRDLW TRDSW= ',TSRFC, TRDLW, TRDSW - -!how am i going to get this information? -! NPREC = INT(TPREC *TSPH+D50) -! NHEAT = INT(THEAT *TSPH+D50) -! NCLOD = INT(TCLOD *TSPH+D50) -! NRDSW = INT(TRDSW *TSPH+D50) -! NRDLW = INT(TRDLW *TSPH+D50) -! NSRFC = INT(TSRFC *TSPH+D50) -!how am i going to get this information? -! -! IF(ME==0)THEN -! WRITE(6,*)' ' -! WRITE(6,*)'DERIVED TIME STEPPING CONSTANTS' -! WRITE(6,*)' NPREC,NHEAT,NSRFC : ',NPREC,NHEAT,NSRFC -! WRITE(6,*)' NCLOD,NRDSW,NRDLW : ',NCLOD,NRDSW,NRDLW -! ENDIF -! -! COMPUTE DERIVED MAP OUTPUT CONSTANTS. - DO L = 1,LSM - ALSL(L) = ALOG(SPL(L)) - END DO -! - if(submodelname == 'NEST') then - print *,'NMM NEST mode: use projection center as projection center' - elseif(submodelname == 'MOAD') then - print *,'NMM MOAD mode: use domain center as projection center' - CENLAT=NINT(DCENLAT*1000) - CENLON=NINT(DCENLON*1000) - elseif(i_parent_start>1 .or. j_parent_start>1) then - print *,'No submodel specified for nested domain. Using projection center as projection center.' - else - print *,'No submodel specified for MOAD. Using domain center as projection center' - endif - - - if(me==0)then - ! write out copygb_gridnav.txt - ! provided by R.Rozumalski - NWS - - inav=10 - - TRUELAT1 = CENLAT - TRUELAT2 = CENLAT - - IFDX = NINT (dxval*107.) - IFDY = NINT (dyval*110.) - - open(inav,file='copygb_gridnav.txt',form='formatted', & - status='unknown') - - print *, ' MAPTYPE :',maptype - print *, ' IM :',IM*2-1 - print *, ' JM :',JM - print *, ' LATSTART :',LATSTART - print *, ' LONSTART :',LONSTART - print *, ' CENLAT :',CENLAT - print *, ' CENLON :',CENLON - print *, ' TRUELAT2 :',TRUELAT2 - print *, ' TRUELAT1 :',TRUELAT1 - print *, ' DX :',IFDX*0.001 - print *, ' DY :',IFDY*0.001 - - IF(MAPTYPE==0 .OR. MAPTYPE==203)THEN !A STAGGERED E-GRID - - IMM = 2*IM-1 - IDXAVE = ( IFDY + IFDX ) * 0.5 - - ! If the Center Latitude of the domain is located within 15 degrees - ! of the equator then use a a regular Lat/Lon navigation for the - ! remapped grid in copygb; otherwise, use a Lambert conformal. Make - ! sure to specify the correct pole for the S. Hemisphere (LCC). - ! - IF ( abs(CENLAT)>15000) THEN - write(6,*)' Copygb LCC Navigation Information' - IF (CENLAT >0) THEN ! Northern Hemisphere - write(6,1000) IMM,JM,LATSTART,LONSTART,CENLON, & - IFDX,IFDY,CENLAT,CENLAT - write(inav,1000) IMM,JM,LATSTART,LONSTART,CENLON, & - IFDX,IFDY,CENLAT,CENLAT - ELSE ! Southern Hemisphere - write(6,1001) IMM,JM,LATSTART,LONSTART,CENLON, & - IFDX,IFDY,CENLAT,CENLAT - write(inav,1001) IMM,JM,LATSTART,LONSTART,CENLON, & - IFDX,IFDY,CENLAT,CENLAT - END IF - ELSE - dlat = (latnm-latsm)/(JM-1) - nlat = INT (dlat) - - if (lonem < 0) lonem = 360000. + lonem - if (lonwm < 0) lonwm = 360000. + lonwm - - dlon = lonem-lonwm - if (dlon < 0.) dlon = dlon + 360000. - dlon = (dlon)/(IMM-1) - nlon = INT (dlon) - - write(6,*)' Copygb Lat/Lon Navigation Information' - write(6,2000) IMM,JM,latsm,lonwm,latnm,lonem,nlon,nlat - write(inav,2000) IMM,JM,latsm,lonwm,latnm,lonem,nlon,nlat - ENDIF - close(inav) - - 1000 format('255 3 ',2(I3,x),I6,x,I7,x,'8 ',I7,x,2(I6,x),'0 64', & - 2(x,I6)) - 1001 format('255 3 ',2(I3,x),I6,x,I7,x,'8 ',I7,x,2(I6,x),'128 64', & - 2(x,I6),' -90000 0') - 2000 format('255 0 ',2(I3,x),2(I7,x),'8 ',2(I7,x),2(I7,x),'64') - END IF ! maptype - - !HC WRITE IGDS OUT FOR WEIGHTMAKER TO READ IN AS KGDSIN - igdout=110 - if (maptype == 1)THEN ! Lambert conformal - WRITE(igdout)3 - WRITE(6,*)'igd(1)=',3 - WRITE(igdout)im - WRITE(igdout)jm - WRITE(igdout)LATSTART - WRITE(igdout)LONSTART - WRITE(igdout)8 - WRITE(igdout)CENLON - WRITE(igdout)DXVAL - WRITE(igdout)DYVAL - WRITE(igdout)0 - WRITE(igdout)64 -! JW WRITE(igdout)TRUELAT2 -! JW WRITE(igdout)TRUELAT1 - WRITE(igdout)255 - ELSE IF(MAPTYPE == 2)THEN !Polar stereographic - WRITE(igdout)5 - WRITE(igdout)im - WRITE(igdout)jm - WRITE(igdout)LATSTART - WRITE(igdout)LONSTART - WRITE(igdout)8 - WRITE(igdout)CENLON - WRITE(igdout)DXVAL - WRITE(igdout)DYVAL - WRITE(igdout)0 - WRITE(igdout)64 -! JW WRITE(igdout)TRUELAT2 !Assume projection at +-90 -! JW WRITE(igdout)TRUELAT1 - WRITE(igdout)255 - ! Note: The calculation of the map scale factor at the standard - ! lat/lon and the PSMAPF - ! Get map factor at 60 degrees (N or S) for PS projection, which will - ! be needed to correctly define the DX and DY values in the GRIB GDS - if (TRUELAT1 < 0.) THEN - LAT = -60. - else - LAT = 60. - end if - - CALL MSFPS (LAT,TRUELAT1*0.001,PSMAPF) - - ELSE IF(MAPTYPE == 3)THEN !Mercator - WRITE(igdout)1 - WRITE(igdout)im - WRITE(igdout)jm - WRITE(igdout)LATSTART - WRITE(igdout)LONSTART - WRITE(igdout)8 - WRITE(igdout)latlast - WRITE(igdout)lonlast -! JW WRITE(igdout)TRUELAT1 - WRITE(igdout)0 - WRITE(igdout)64 - WRITE(igdout)DXVAL - WRITE(igdout)DYVAL - WRITE(igdout)255 - ELSE IF(MAPTYPE==0 .OR. MAPTYPE==203)THEN !A STAGGERED E-GRID - WRITE(igdout)203 - WRITE(igdout)im - WRITE(igdout)jm - WRITE(igdout)LATSTART - WRITE(igdout)LONSTART - WRITE(igdout)136 - WRITE(igdout)CENLAT - WRITE(igdout)CENLON - WRITE(igdout)DXVAL - WRITE(igdout)DYVAL - WRITE(igdout)64 - WRITE(igdout)0 - WRITE(igdout)0 - WRITE(igdout)0 - -! following for hurricane wrf post - open(inav,file='copygb_hwrf.txt',form='formatted', & - status='unknown') - LATEND=LATSTART+(JM-1)*dyval - LONEND=LONSTART+(IMM-1)*dxval - write(10,1010) IMM,JM,LATSTART,LONSTART,LATEND,LONEND, & - dxval,dyval - -1010 format('255 0 ',2(I3,x),I6,x,I7,x,'136 ',I6,x,I7,x, & - 2(I6,x),'64') - close (inav) - - END IF - end if -! -! -! close up shop - call ext_ncd_ioclose ( DataHandle, Status ) - - RETURN - END diff --git a/sorc/ncep_post.fd/WRFPOST.f b/sorc/ncep_post.fd/WRFPOST.f index 571174dd7..e6e3e8ab4 100644 --- a/sorc/ncep_post.fd/WRFPOST.f +++ b/sorc/ncep_post.fd/WRFPOST.f @@ -44,6 +44,8 @@ !! 21-06-20 W Meng - remove reading grib1 and gfsio lib !! 21-10-22 KaYee Wong - created formal fortran namelist for itag !! 21-11-03 Tracy Hertneky - Removed SIGIO option +!! 22-01-14 W Meng - Remove interfaces INITPOST_GS_NEMS, INITPOST_NEMS_MPIIO +!! INITPOST_NMM and INITPOST_GFS_NETCDF. !! !! USAGE: WRFPOST !! INPUT ARGUMENT LIST: @@ -272,11 +274,6 @@ PROGRAM WRFPOST ,trim(fileName),trim(fileNameFlux) end if -! -! set ndegr -! if(grib=='grib1') then -! gdsdegr = 1000. -! else if (grib=='grib2') then if(grib=='grib2') then gdsdegr = 1.d6 endif @@ -302,14 +299,7 @@ PROGRAM WRFPOST !set control file name fileNameFlat='postxconfig-NT.txt' -!KaYee if(MODELNAME == 'RAPR') then -!KaYee read(5,*,iostat=iret,end=119) kpo -!KaYee else - read(5,nampgb,iostat=iret,end=119) -!KaYee endif -! if(kpo > komax)print*,'pressure levels cannot exceed ',komax; STOP -! if(kth > komax)print*,'isent levels cannot exceed ',komax; STOP -! if(kpv > komax)print*,'PV levels cannot exceed ',komax; STOP + read(5,nampgb,iostat=iret,end=119) 119 continue if(me == 0) then print*,'komax,iret for nampgb= ',komax,iret @@ -332,15 +322,6 @@ PROGRAM WRFPOST if(me == 0) then print*,'using pressure levels from POSTGPVARS' endif -!KaYee if(MODELNAME == 'RAPR')then -!KaYee read(5,*) (po(l),l=1,kpo) -! CRA READ VALID TIME UNITS -!KaYee read(5,121) VTIMEUNITS -!KaYee if(me == 0) then -!KaYee print*,'VALID TIME UNITS = ', VTIMEUNITS -!KaYee endif -! CRA -!KaYee endif lsm = kpo if( .not. popascal ) then untcnvt = 100. @@ -360,21 +341,8 @@ PROGRAM WRFPOST LSMP1 = LSM+1 if (me==0) print*,'LSM, SPL = ',lsm,spl(1:lsm) -!Chuang, Jun and Binbin: If model is RSM, read in precip accumulation frequency (sec) from unit5 - if(MODELNAME == 'RSM') then - read(5,115)PRNTSEC - TPREC = PRNTSEC/3600.0 - print*,'TPREC in RSM= ',TPREC - end if - 115 format(f7.1) 116 continue -!KaYee if(MODELNAME == 'GFS') then -! read(5,*) line -!KaYee read(5,111,end=125) fileNameFlat -!KaYee 125 continue -! if(len_trim(fileNameFlat)<5) fileNameFlat = 'postxconfig-NT.txt' -!KaYee if (me == 0) print*,'Post flat name in GFS= ',trim(fileNameFlat) -!KaYee endif + ! set PTHRESH for different models if(MODELNAME == 'NMM')then PTHRESH = 0.000004 @@ -648,16 +616,10 @@ PROGRAM WRFPOST IF(MODELNAME == 'NCAR' .OR. MODELNAME == 'RAPR') THEN print*,'CALLING INITPOST TO PROCESS NCAR NETCDF OUTPUT' CALL INITPOST - ELSE IF(MODELNAME == 'NMM') THEN - print*,'CALLING INITPOST_NMM TO PROCESS NMM NETCDF OUTPUT' - CALL INITPOST_NMM ELSE IF (MODELNAME == 'FV3R') THEN ! use netcdf library to read output directly print*,'CALLING INITPOST_NETCDF' CALL INITPOST_NETCDF(ncid2d,ncid3d) - ELSE IF (MODELNAME == 'GFS') THEN - print*,'CALLING INITPOST_GFS_NETCDF' - CALL INITPOST_GFS_NETCDF(ncid3d) ELSE PRINT*,'POST does not have netcdf option for model,',MODELNAME,' STOPPING,' STOP 9998 @@ -680,10 +642,6 @@ PROGRAM WRFPOST ELSE IF(TRIM(IOFORM) == 'binarynemsio') THEN IF(MODELNAME == 'NMM') THEN CALL INITPOST_NEMS(NREC,nfile) - ELSE IF(MODELNAME == 'GFS') THEN -! CALL INITPOST_GFS_NEMS(NREC,iostatusFlux,iostatusD3D,nfile,ffile) - CALL INITPOST_GFS_NEMS(NREC,iostatusFlux,iostatusD3D,iostatusAER, & - nfile,ffile,rfile) ELSE PRINT*,'POST does not have nemsio option for model,',MODELNAME,' STOPPING,' STOP 9998 @@ -691,11 +649,7 @@ PROGRAM WRFPOST END IF ELSE IF(TRIM(IOFORM) == 'binarynemsiompiio')THEN - IF(MODELNAME == 'NMM') THEN -! close nemsio file for serial read - call nemsio_close(nfile,iret=status) - CALL INITPOST_NEMS_MPIIO() - ELSE IF(MODELNAME == 'GFS') THEN + IF(MODELNAME == 'GFS') THEN ! close nemsio file for serial read call nemsio_close(nfile,iret=status) call nemsio_close(ffile,iret=status) diff --git a/sorc/ncep_post.fd/build_upp_lib.sh b/sorc/ncep_post.fd/build_upp_lib.sh deleted file mode 100755 index b3a01dae3..000000000 --- a/sorc/ncep_post.fd/build_upp_lib.sh +++ /dev/null @@ -1,54 +0,0 @@ -SHELL=/bin/sh - -module purge -set -x -mac=$(hostname | cut -c1-1) -mac2=$(hostname | cut -c1-2) - -if [ $mac2 = hf ] ; then # For Hera - machine=hera - . /etc/profile - . /etc/profile.d/modules.sh -elif [ $mac = f ] ; then # For Jet - machine=jet - . /etc/profile - . /etc/profile.d/modules.sh -elif [ $mac = v -o $mac = m ] ; then # For Dell - machine=wcoss_dell_p3 - . $MODULESHOME/init/bash -elif [ $mac = t -o $mac = e -o $mac = g ] ; then # For WCOSS - machine=wcoss - . /usrx/local/Modules/default/init/bash -elif [ $mac2 = s4 ] ; then # For S4 - machine=s4 - . /etc/profile -elif [ $mac = l -o $mac = s ] ; then # wcoss_c (i.e. luna and surge) - export machine=cray-intel -elif [ $mac = O ] ; then # For Orion - machine=orion - . /etc/profile -fi -export version=${1:-"v8.0.0"} - -moduledir=`dirname $(readlink -f ../../modulefiles/post)` -module use -a ${moduledir} -module load upp/lib-${machine} -#module load nceppost_modulefile - -# -module list - -#sleep 1 - -BASE=`pwd` - -##################################### -cd ${BASE} -rm *.o *.mod incmod -#mkdir -m 775 -p $BASE/../../lib/include/ncep_post_${version}_4 -make -f makefile_lib clean -mkdir -m 775 -p include/upp_4 -make -f makefile_lib - -exit 0 - diff --git a/sorc/ncep_post.fd/makefile b/sorc/ncep_post.fd/makefile deleted file mode 100644 index 7a0a614d8..000000000 --- a/sorc/ncep_post.fd/makefile +++ /dev/null @@ -1,258 +0,0 @@ -#!/bin/ksh -set -x -mac=$(hostname | cut -c1-1) -mac2=$(hostname | cut -c1-2) -################################# options ############################################### -#export CLEAN=NO # comment this line to clean before compiling -#debug=YES # turn on debug mode - default - NO - make_post_lib=YES # create post library - default - NO - make_post_exec=YES # create post executable - default - YES -#make_nowrf=YES # compile with wrf stub instead of WRF lib -################################# options ############################################### -# -if [ $mac2 = ga ] ; then # For GAEA - machine=gaea - center=${center:-ncep} - make_nowrf=${make_nowrf:-YES} # to compile with wrf stub instead of WRF lib -elif [ $mac2 = tf ] ; then # For Theia - machine=theia - make_nowrf=${make_nowrf:-YES} # to compile with wrf stub instead of WRF lib -elif [ $mac = z -o $mac = h -o $mac = f ] ; then # For ZEUS - machine=zeus - make_nowrf=${make_nowrf:-YES} # to compile with wrf stub instead of WRF lib -elif [ $mac = t -o $mac = e -o $mac = g ] ; then # For WCOSS - machine=wcoss -elif [ $mac = l -o $mac = s ] ; then # wcoss_c (i.e. luna and surge) - export machine=wcoss_c - make_nowrf=${make_nowrf:-YES} # to compile with wrf stub instead of WRF lib -fi -debug=${debug:-NO} -export make_post_lib=${make_post_lib:-NO} -export make_post_exec=${make_post_exec:-YES} -export make_nowrf=${make_nowrf:- NO} -if [ $machine = wcoss ] ; then - export NETCDFPATH="/usrx/local/NetCDF/3.6.3" - export WRFPATH="/nwprod/sorc/wrf_shared.v1.1.0" - export NWPROD="/nwprod" - export XMLPATH=$NWPROD - export IPPATH=$NWPROD - export SPPATH=/usrx/local/nceplibs - export BACIOPATH=/usrx/local/nceplibs - export ipv="" - export spv=_v2.0.2p - export crtmv=2.0.6 - export crtmv_inc=$crtmv - export xmlv=_v2.0.0 - export baciov=_v2.0.1p - export FC=mpiifort - export CPP="/lib/cpp -P" - export CPPFLAGS="-DLINUX" - export CC=cc - if [ $debug = YES ] ; then - export OPTS="-O0 -openmp " - export DEBUG="-g -traceback -convert big_endian -ftrapuv -check bounds -check format -check output_conversion -check pointers -check uninit -fp-stack-check" - else - export OPTS="-O3 -convert big_endian -fp-model source -openmp -xAVX" - export DEBUG="" - fi - export LIST="" - export FREE="-FR" - export TRAPS="" - export PROFILE="" -elif [ $machine = wcoss_c ] ; then - export FC=ftn - export CPP="/lib/cpp -P" - export CPPFLAGS="-DLINUX" - export CC=cc - if [ $debug = YES ] ; then - export OPTS="-O0 -openmp " - export DEBUG="-g -traceback -convert big_endian -ftrapuv -check bounds -check format -check output_conversion -check pointers -check uninit -fp-stack-check" - else - export OPTS="-O3 -convert big_endian -fp-model source -openmp -xAVX" - export DEBUG="" - fi - export LIST="" - export FREE="-FR" - export TRAPS="" - export PROFILE="" -elif [ $machine = zeus ] ; then - export NETCDFPATH="/apps/netcdf/3.6.3/intel" - export WRFPATH="/scratch2/portfolios/NCEPDEV/meso/save/Dusan.Jovic/WRFV3" - export NWPROD="/contrib/nceplibs/nwprod" - export XMLPATH="/home/Hui-Ya.Chuang" - export IPPATH=$NWPROD - export SPPATH=$NWPROD - export ipv="" - export spv=_v2.0.1 - export crtmv=2.0.7 - export FC="ifort -lmpi" - export CPP="/lib/cpp -P" - export CC=cc - export ARCH="" - export CPPFLAGS="-DLINUX" - if [ $debug = YES ] ; then - export OPTS="-O0 -openmp -g" - export DEBUG="-g -check all -ftrapuv -convert big_endian -fp-stack-check -fstack-protector -heap-arrays -recursive -traceback" - else - export export OPTS="-O3 -convert big_endian -traceback -g -fp-model source -openmp" - export DEBUG="" - fi - export LIST="" - export FREE="-FR" - export TRAPS="" - export PROFILE="" -elif [ $machine = theia ] ; then - export NETCDFPATH="/apps/netcdf/4.3.0-intel" - export WRFPATH="/scratch4/NCEPDEV/global/save/Shrinivas.Moorthi/theia/nceplibs/nwprod/lib/sorc/WRFV3" - export NWPROD="/scratch4/NCEPDEV/global/save/Shrinivas.Moorthi/theia/nceplibs/nwprod" - export ipv=_v2.0.3 - export spv="" - export crtmv=2.0.7 - export gfsiov="" - export w3ev=_v2.1.0 - export w3nv="" - export xmlv=_v2.0.0 - export g2tv="" - export baciov=_v2.1.0 - export XMLPATH=$NWPROD - export IPPATH=$NWPROD - export SPPATH=$NWPROD - export BACIOPATH=$NWPROD/lib - export FC=mpiifort - export CPP="/lib/cpp -P" - export CC=cc - export ARCH="" - export CPPFLAGS="-DLINUX" - if [ $debug = YES ] ; then - export OPTS="-O0 -openmp -g" - export DEBUG="-g -check all -ftrapuv -convert big_endian -fp-stack-check -fstack-protector -heap-arrays -recursive -traceback" - else - export export OPTS="-O3 -convert big_endian -traceback -g -fp-model source -openmp" - export DEBUG="" - fi - export LIST="" - export FREE="-FR" - export TRAPS="" - export PROFILE="" -elif [ $machine = gaea ] ; then - export NETCDFPATH="/opt/cray/netcdf/4.3.2/INTEL/140" - export WRFPATH="/lustre/f1/unswept/ncep/Shrinivas.Moorthi/nceplibs/nwprod/lib/sorc/WRFV3" - export NWPROD="/lustre/f1/unswept/ncep/Shrinivas.Moorthi/nceplibs/nwprod" - export IPPATH=$NWPROD - export SPPATH=$NWPROD - export baciov=_v2.1.0 - export BACIOPATH=/lustre/f1/unswept/ncep/Shrinivas.Moorthi/nceplibs/nwprod/lib/sorc/bacio_fast_byteswap/bacio${baciov}_4 - export ipv="" - export spv=_v2.0.1 - export xmlv=_v2.0.0 - export FC=ftn - export CPP="/lib/cpp -P" - export ARCH="" - export CPPFLAGS="-DLINUX" - export CC=icc - if [ $debug = YES ] ; then - export OPTS="-O0 -g" - export DEBUG="-g -check all -ftrapuv -convert big_endian -fp-stack-check -fstack-protector -heap-arrays -recursive -traceback" - else - export export OPTS="-O3 -convert big_endian -traceback -g -fp-model source" - export DEBUG="" - fi - export LIST="" - export FREE=-FR - export TRAPS="" - export PROFILE="" - - export gfsiov="" - export crtmv=2.0.7 - export w3ev=_v2.1.0 - export w3nv="" -fi -export crtmv=${crtmv:-2.0.7} -export crtmv_inc=${crtmv_inc:-v$crtmv} -export XMLPATH=${XMLPATH:-$NWPROD} -export BACIOPATH=${BACIOPATH:-$NWPROD/lib} -export xmlv=${xmlv:-""} -export w3ev=${w3ev:-_v2.0.3} -export ipv=${ipv:-""} -export spv=${spv:-""} - -if [ ${CLEAN:-YES} = YES ] ; then make -f Makefile clean ; fi - -export CFLAGS="-DLINUX -Dfunder -DFortranByte=char -DFortranInt=int -DFortranLlong='long long'" -if [ $machine = wcoss_c ] ; then - - if [ $make_nowrf = YES ] ; then - WRF_INC= - WRF_LIB= - fi - NETCDF_LIB="${NETCDF}/lib/libnetcdf.a" - export FFLAGS="${OPTS} ${FREE} ${TRAPS} ${DEBUG} -I${XMLPARSE_INC} -I${G2_INC4} -I${G2TMPL_INC} -I${NEMSIO_INC} -I${SIGIO_INC4} -I${SFCIO_INC4} -I${GFSIO_INC4} -I${W3EMC_INC4} -I${CRTM_INC} -I${NETCDF_INCLUDE} -I${PNG_INC}" - - export LIBS="${WRF_LIB} ${XMLPARSE_LIB} ${G2_LIB4} ${G2TMPL_LIB} ${NEMSIO_LIB} ${GFSIO_LIB4} ${SIGIO_LIB4} ${SFCIO_LIB4} ${IP_LIB4} ${SP_LIB4} ${W3NCO_LIB4} ${W3EMC_LIB4} ${BACIO_LIB4} ${CRTM_LIB} ${NETCDF_LIB} ${PNG_LIB} ${JASPER_LIB} ${Z_LIB}" -else - SFCIO_INC="-I${NWPROD}/lib/incmod/sfcio_4" - SFCIO_LIB="${NWPROD}/lib/libsfcio_4.a" - - NEMSIO_INC="-I${NWPROD}/lib/incmod/nemsio" - NEMSIO_LIB="-L${NWPROD}/lib -lnemsio" - BACIO_LIB="-L${BACIOPATH} -lbacio${baciov}_4" - SIGIO_INC="-I${NWPROD}/lib/incmod/sigio_4" - SIGIO_LIB="${NWPROD}/lib/libsigio_4.a" - NCDLIBS="-L${NETCDFPATH} -lnetcdf" - NCDFFLAGS="-I${NETCDFPATH}" - if [ $make_nowrf = YES ] ; then - WRF_INC= - WRF_LIB= - else - WRF_INC="-I${WRFPATH}/external/io_quilt -I${WRFPATH}/frame" - WRF_LIB="${WRFPATH}/main/libwrflib.a ${WRFPATH}/frame/pack_utils.o ${WRFPATH}/frame/module_internal_header_util.o ${WRFPATH}/external/io_grib1/libio_grib1.a ${WRFPATH}/external/io_grib_share/libio_grib_share.a ${WRFPATH}/external/io_int/libwrfio_int.a ${WRFPATH}/external/io_netcdf/libwrfio_nf.a ${WRFPATH}/external/esmf_time_f90/libesmf_time.a ${WRFPATH}/external/RSL_LITE/librsl_lite.a" - fi - - G2_INC="-I${NWPROD}/lib/incmod/g2_4 -I${NWPROD}/lib/incmod/g2tmpl${g2tv}" - G2_LIB="-L${NWPROD}/lib -lg2tmpl${g2tv} -lg2_4 -ljasper -lpng -lz" - - GFSIO_INC="-I${NWPROD}/lib/incmod/gfsio${gfsiov}_4" - GFSIO_LIB="-L${NWPROD}/lib -lgfsio${gfsiov}_4" - - IP_LIB="-L${IPPATH}/lib -lip${ipv}_4" - SP_LIB="-L${SPPATH} -lsp${sp}_4" - - W3_INC="-I${NWPROD}/lib/incmod/w3emc${w3ev}_4" - W3_LIB="-L${NWPROD}/lib -lw3nco${w3nv}_4 -lw3emc${w3ev}_4" - - CRTM_INC="-I${NWPROD}/lib/incmod/crtm_${crtmv_inc}" - CRTM_LIB="-L${NWPROD}/lib -lcrtm_v${crtmv}" - XML_INC="-I${XMLPATH}/lib/incmod/xmlparse${xmlv}" - XML_LIB="-L${XMLPATH}/lib -lxmlparse${xmlv}" - - NETCDF_LIB="${NETCDFPATH}/lib/libnetcdf.a" - NETCDF_INC="-I${NETCDFPATH}/include" - - export FFLAGS="${OPTS} ${FREE} ${TRAPS} ${DEBUG} ${WRF_INC} ${XML_INC} ${G2_INC} ${NEMSIO_INC} ${GFSIO_INC} ${SIGIO_INC} ${SFCIO_INC} ${W3_INC} ${CRTM_INC} ${NETCDF_INC}" - - export LIBS="${WRF_LIB} ${XML_LIB} ${G2_LIB} ${NEMSIO_LIB} ${GFSIO_LIB} ${SIGIO_LIB} ${SFCIO_LIB} ${IP_LIB} ${SP_LIB} ${W3_LIB} ${BACIO_LIB} ${CRTM_LIB} ${NETCDF_LIB}" - -fi -if [ $make_post_lib = NO ] ; then - if [ $make_post_exec = YES ] ; then - if [ $make_nowrf = YES ] ; then - _make -f Makefile_nowrf - else - make -f Makefile - fi - fi -else - if [ $make_post_exec = YES ] ; then - if [ $make_nowrf = YES ] ; then - make -f Makefile_nowrf - else - make -f Makefile - fi - fi - export POSTLIBPATH=${POSTLIBPATH:-$(pwd)} - if [ ${CLEAN:-YES} = YES ] ; then rm -rf $POSTLIBPATH/include/post_4 ; fi - mkdir -p $POSTLIBPATH/include/post_4 - make -f Makefile_lib -fi - - diff --git a/sorc/ncep_post.fd/makefile_dtc b/sorc/ncep_post.fd/makefile_dtc deleted file mode 100644 index 519c2418b..000000000 --- a/sorc/ncep_post.fd/makefile_dtc +++ /dev/null @@ -1,130 +0,0 @@ -SHELL = /bin/sh - -################################################################################ -# -# Makefile for NCEP Post -# -# Use: -# make - build the executable -# make clean - start with a clean slate -# -################################################################################# -# -# Define the name of the executable -# -TARGET = unipost.exe - -# -# build configuration determined before compile -include ../../configure.upp - -# -# directories for shared resources -LOCALINC = -I$(INCMOD) -I$(INCMOD)/crtm2 -NCDFINC = -I$(NETCDFPATH)/include -GRIB2INC = -I$(GRIB2SUPT_INC) - -LLIBDIR = -L$(LIBDIR) -UPPLIBS = -lCRTM $(SERIAL_MPI_LIB) -lxmlparse -NCEPLIBS = $(NCEPLIBLIB) $(NCEPLIB_FLAGS) $(GRIB2SUPT_LIB) -NCDFLIBS = -L$(NETCDFPATH)/lib $(NETCDFLIBS) - -LIBS = $(LLIBDIR) $(UPPLIBS) $(GRIB2LIBS) $(NCEPLIBS) $(NCDFLIBS) - -MODULES = - -# -# Compilation / Link Flag Configuration -EXTRA_CPPFLAGS = -EXTRA_FFLAGS = -c $(LOCALINC) $(NETCDFINC) $(NCDFINC) $(NCEPLIBINC) -#EXTRA_LDFLAGS = $(LIBS) -Wl,-Map=lm -EXTRA_LDFLAGS = $(LIBS) -EXTRA_CFLAGS = -Dfunder -DFortranByte=char -DFortranInt=int -DFortranLlong='long long' - -# -# ----------- -# Threaded object files -# ----------- -OBJS_FT = wrf_io_flags.o getVariable.o \ - getIVariableN.o kinds_mod.o machine.o physcons.o \ - native_endianness.o \ - retrieve_index.o ZENSUN.o \ - CLDFRAC_ZHAO.o GFSPOST.o GFSPOSTSIG.o GETGBANDSCATTER.o \ - blockIO.o - -# ----------- -# Non-threaded object files -# ----------- -#OBJXML = post_t.o - -OBJS_F = VRBLS2D_mod.o VRBLS3D_mod.o VRBLS4D_mod.o MASKS_mod.o PMICRPH.o SOIL_mod.o CMASSI.o \ - CTLBLK.o GRIDSPEC.o \ - LOOKUP.o PARAMR.o RHGRD.o RQSTFLD.o xml_perl_data.o cuparm.o params.o svptbl.o get_postfilename.o grib2_module.o \ - SET_LVLSXML.o FILL_PSETFLD.o BNDLYR.o BOUND.o CALCAPE.o \ - CALDWP.o CALDRG.o CALHEL.o CALLCL.o CALMCVG.o CALPOT.o CALPW.o CALRH.o CALRCH.o \ - CALRH_GSD.o CALSTRM.o CALTAU.o CALTHTE.o CALVIS.o CALVIS_GSD.o CALVOR.o CALWXT.o $(LINUX_OBJ)\ - CALWXT_RAMER.o CALWXT_BOURG.o CALWXT_REVISED.o CALRH_PW.o CALWXT_EXPLICIT.o \ - CALWXT_DOMINANT.o CLDRAD.o \ - CLMAX.o COLLECT.o COLLECT_LOC.o DEWPOINT.o FDLVL.o FGAMMA.o FIXED.o FRZLVL.o FRZLVL2.o \ - GET_BITS.o INITPOST.o LFMFLD.o MAPSSLP.o MISCLN.o MDL2STD_P.o MIXLEN.o MDL2P.o ETAMP_Q2F.o \ - MDLFLD.o MPI_FIRST.o MPI_LAST.o NGMFLD.o NGMSLP.o OTLFT.o OTLIFT.o SLP_new.o SLP_NMM.o \ - EXCH.o PARA_RANGE.o PROCESS.o INITPOST_NMM.o EXCH2.o READCNTRL.o READ_xml.o \ - SET_OUTFLDS.o SCLFLD.o SERVER.o \ - SETUP_SERVERS.o SMOOTH.o SURFCE.o SPLINE.o TABLE.o TABLEQ.o TRPAUS.o TTBLEX.o WETBULB.o \ - WRFPOST.o CALMICT.o MICROINIT.o GPVS.o MDL2SIGMA.o ETCALC.o CANRES.o \ - CALGUST.o WETFRZLVL.o SNFRAC.o MDL2AGL.o SNFRAC_GFS.o AVIATION.o DEALLOCATE.o \ - CALPBL.o MDL2SIGMA2.o INITPOST_GFS.o CALRH_GFS.o LFMFLD_GFS.o \ - CALRAD_WCLOUD_newcrtm.o MDL2THANDPV.o CALPBLREGIME.o POLEAVG.o INITPOST_NEMS.o \ - GETNEMSNDSCATTER.o ICAOHEIGHT.o INITPOST_GFS_NEMS.o \ - GEO_ZENITH_ANGLE.o GFIP3.o GRIDAVG.o CALUPDHEL.o MSFPS.o INITPOST_GFS_SIGIO.o\ - AllGETHERV_GSD.o SELECT_CHANNELS.o ALLOCATE_ALL.o INITPOST_NEMS_MPIIO.o ASSIGNNEMSIOVAR.o INITPOST_GFS_NEMS_MPIIO.o \ - INITPOST_NETCDF.o INITPOST_GFS_NETCDF.o \ - gtg_ctlblk.o gtg_indices.o gtg_filter.o gtg_compute.o gtg_config.o map_routines.o gtg_algo.o CALVESSEL.o \ - CALHEL2.o CALCAPE2.o - -OBJS = $(OBJS_F) $(OBJXML) $(OBJS_FT) - -# ----------- -# Targets -# ----------- -all: $(TARGET) - -$(TARGET): $(XML_DEPS) $(OBJS) $(MODULES) - $(F90) -o $@ $(FFLAGS) $(MODULES) $(OBJS) $(LDFLAGS) $(EXTRA_LDFLAGS) - $(CP) $@ $(BINDIR) - -# This insures a dependency found in some files -- watch file order above remains -- should -# be done w/ dependencies -$(OBJS_F): $(OBJS_FT) $(OBJXML) - -# -# These files are configurable, but rarely change -clean: - @echo -e "\n<><><><> CLEAN <><><><>\n$@ in `pwd`" - $(RM) $(TARGET) $(OBJS) *.lst *.mod - $(RM) $(BINDIR)/$(TARGET) - for f in `ls -1 *.F|sed "s/.F$$/.f/"` ; do \ - $(RM) $$f ; \ - done - -distclean: clean - -.IGNORE: -.PHONY: clean - -.SUFFIXES: -.SUFFIXES: .F .f .f90 .o .c - -.F.o: - $(CPP) $(CPP_FLAGS) $(EXTRA_CPPFLAGS) $< > $*.f - $(F90) -c $(FFLAGS) $(EXTRA_FFLAGS) $*.f - -.f.o: - $(F90) -c $(FFLAGS) $(EXTRA_FFLAGS) $< - -.f90.o: - $(F90) -c $(FFLAGS) $(EXTRA_FFLAGS) $< - -.c.o: - ${CC} -c ${CFLAGS} $(EXTRA_CFLAGS) $< - diff --git a/sorc/ncep_post.fd/makefile_lib b/sorc/ncep_post.fd/makefile_lib deleted file mode 100644 index 37d48af6e..000000000 --- a/sorc/ncep_post.fd/makefile_lib +++ /dev/null @@ -1,146 +0,0 @@ -################################################################################ -# -# Makefile for upp (NCEP Post) -# -# Use: -# make - build the executable -# make clean - start with a clean slate -# -# The following macros will be of interest: -# -# TARGET - name of the executable -# FC - name of Fortran compiler -# CPP - name of CPP -# ARCH - architecture -# CPPFLAGS - CPP flags -# OPTS - compiler code optimizations -# LIST - source listing -# SMP - threading -# TRAPS - runtime traps for floating point exceptions -# PROFILE - source code profiling ( -pg ) -# DEBUG - -g -# MEM - user data area and stack size -# MAP - load map -# W3LIB - w3lib -# BACIO - bacio lib -# ESSL - ESSL library -# MASS - MASS library -# HPMLIB - hpm lib -# SEARCH - library search location -# -# This version for eta_post with more intelligent memory allocation -# Jim Tuccillo Feb 2001 -# -# This version for eta_post with asynchronous I/O server. -# Jim Tuccillo June 2001 - -# This version for NEMS_POST -# Jun Wang June 2010 -# -# This version for GFS V16 in-line post -# Wen Meng Ocotomber 2020 -# -################################################################################# -# -# Define the name of the executable -# - #POSTLIBPATH=../.. - #TARGET = ${POSTLIBPATH}/lib/libncep_post_${version}_4.a - #INCMOD= ${POSTLIBPATH}/lib/include/ncep_post_${version}_4 - TARGET = libupp_4.a - INCMOD = include/upp_4 - AR = ar - ARFLAGS = -rv - -# -# CPP, Compiler, and Linker Options -# - -#FC = mpfort -compiler ifort -#CPP = /lib/cpp -P -FC = $(myFC) $(myFCFLAGS) -CPP = $(myCPP) $(myCPPFLAGS) -ARCH = auto -CPPFLAGS = -DLINUX -OPTS = -O -fp-model strict -LIST = -FREE = -FR -#TRAPS = -qflttrap=ov:und:zero:inv:inex -qcheck -qinitauto=FF -TRAPS = -PROFILE = -DEBUG = -g -CFLAGS = -DLINUX -Dfunder -DFortranByte=char -DFortranInt=int -DFortranLlong='long long' -W3LIBDIR = /nwprod/lib - -SEARCH = -# -# Assemble Options -# -#FFLAGS = $(OPTS) $(FREE) $(TRAPS) $(DEBUG) -I$(CRTM_INC) -I$(W3EMC_INC4) -I$(G2_INC4) -I$(G2TMPL_INC) -I$(XMLPARSE_INC) -I$(SIGIO_INC4) -I$(GFSIO_INC4) -FFLAGS = $(OPTS) $(FREE) $(TRAPS) $(DEBUG) -I$(CRTM_INC) -I$(W3EMC_INC4) -I$(G2_INC4) -I$(G2TMPL_INC) -I$(SIGIO_INC4) -I$(GFSIO_INC4) -FFLAGST = $(OPTS) $(FREE) $(TRAPS) $(DEBUG) -I$(CRTM_INC) -I$(W3EMC_INC4) -I$(SIGIO_INC4) -I$(GFSIO_INC4) - -# -# Threaded object files -# -OBJST= kinds_mod.o machine.o physcons.o ZENSUN.o CLDFRAC_ZHAO.o GFSPOST.o -# -# Non-threaded object files -# -#OBJXML= post_t.o -# -OBJS= VRBLS2D_mod.o VRBLS3D_mod.o VRBLS4D_mod.o MASKS_mod.o PMICRPH.o SOIL_mod.o \ - CMASSI.o CTLBLK.o GRIDSPEC.o LOOKUP.o PARAMR.o RHGRD.o RQSTFLD.o xml_perl_data.o \ - cuparm.o params.o svptbl.o get_postfilename.o grib2_module.o \ - SET_LVLSXML.o FILL_PSETFLD.o \ - BNDLYR.o BOUND.o CALCAPE.o CALDWP.o CALDRG.o CALHEL.o CALLCL.o \ - CALMCVG.o CALPOT.o CALPW.o CALRH.o CALRCH.o CALRH_GSD.o \ - CALSTRM.o CALTAU.o CALTHTE.o CALVIS.o CALVIS_GSD.o CALVOR.o CALWXT.o \ - CALWXT_RAMER.o CALWXT_BOURG.o CALWXT_REVISED.o CALRH_PW.o \ - CALWXT_EXPLICIT.o CALWXT_DOMINANT.o \ - CLDRAD.o CLMAX.o COLLECT.o COLLECT_LOC.o DEWPOINT.o \ - FDLVL.o FGAMMA.o FIXED.o FRZLVL.o FRZLVL2.o \ - GET_BITS.o LFMFLD.o \ - MAPSSLP.o MISCLN.o MDL2STD_P.o MIXLEN.o MDL2P.o MDLFLD.o \ - NGMFLD.o NGMSLP.o OTLFT.o OTLIFT.o SLP_new.o SLP_NMM.o EXCH.o \ - PARA_RANGE.o PROCESS.o EXCH2.o \ - READCNTRL.o READ_xml.o SET_OUTFLDS.o SCLFLD.o \ - SMOOTH.o SURFCE.o \ - SPLINE.o TABLE.o TABLEQ.o TRPAUS.o TTBLEX.o WETBULB.o \ - CALMICT.o MICROINIT.o GPVS.o MDL2SIGMA.o \ - ETCALC.o CANRES.o CALGUST.o WETFRZLVL.o SNFRAC.o MDL2AGL.o SNFRAC_GFS.o \ - AVIATION.o DEALLOCATE.o \ - CALPBL.o MDL2SIGMA2.o CALRH_GFS.o LFMFLD_GFS.o \ - CALRAD_WCLOUD_newcrtm.o MDL2THANDPV.o CALPBLREGIME.o POLEAVG.o \ - ICAOHEIGHT.o \ - GEO_ZENITH_ANGLE.o GFIP3.o GRIDAVG.o CALUPDHEL.o \ - AllGETHERV_GSD.o MSFPS.o SELECT_CHANNELS.o ALLOCATE_ALL.o \ - gtg_ctlblk.o gtg_indices.o gtg_filter.o gtg_compute.o gtg_config.o map_routines.o gtg_algo.o gtg_smoothseams.o CALVESSEL.o \ - CALHEL2.o CALCAPE2.o - - -.SUFFIXES: .F .f .o .f90 .c - -.F.f: - $(CPP) $(CPPFLAGS) $< > $*.f - -$(TARGET): $(OBJST) $(OBJXML) $(OBJS) - $(AR) $(ARFLAGS) $@ $(OBJST) $(OBJXML) $(OBJS) $(LIBS) - mv *.mod $(INCMOD) - -.f.o: - $(FC) $(FFLAGS) -c $< - -.f90.o: - $(FC) $(FFLAGS) -c $< - -.c.o : - ${CC} ${CFLAGS} -c $< - -clean: - /bin/rm -rf libupp_*.a *.lst *.o include -# -#postcntrl_t.o : postcntrl_t.f90 -# $(FC) $(FFLAGS) postcntrl_t.f90 - - diff --git a/sorc/ncep_post.fd/makefile_module b/sorc/ncep_post.fd/makefile_module deleted file mode 100644 index 5b6f2c763..000000000 --- a/sorc/ncep_post.fd/makefile_module +++ /dev/null @@ -1,126 +0,0 @@ -################################################################################################### -# post implement module load standard -# -# 10/15 Lin Gan: Create module load version -# 12/07 Lin Gan: Update to generate post module output -# 07/16 J. Carley: Generalize for multiple machines -# -################################################################################################### - -SHELL=/bin/bash -# -# Define the name of the executable -# -# To generate exe as ncep_post -TARGET = ncep_post -LIB_TARGET = libnceppost.a -AR = ar -ARFLAGS = ruv - -# -# CPP, Compiler, and Linker Options -# - -FC = $(myFC) $(myFCFLAGS) -CPP = $(myCPP) $(myCPPFLAGS) -CPPFLAGS = -DLINUX -FREE = -FR - -NETCDF_INC = -I$(NETCDF)/include -#NETCDF_LDFLAGS = -L$(NETCDF)/lib -lnetcdff -lnetcdf -NETCDF_LDFLAGS = -L$(NETCDF)/lib -lnetcdff -lnetcdf -L$(HDF5_LDFLAGS) $(Z_LIB) - -CFLAGS = -DLINUX -Dfunder -DFortranByte=char -DFortranInt=int -DFortranLlong='long long' - -FFLAGS = $(OPTS) $(FREE) $(DEBUG) \ - -I$(SFCIO_INC4) \ - -I$(NEMSIO_INC) \ - -I$(SIGIO_INC4) \ - -I$(G2_INC4) \ - -I$(G2TMPL_INC) \ - -I$(GFSIO_INC4) \ - -I$(W3EMC_INC4) \ - -I$(CRTM_INC) \ - -I$(IP_INC4) \ - $(NETCDF_INC) - -LIBS = $(WRFIO_LIB) \ - $(G2TMPL_LIB) \ - $(G2_LIB4) \ - $(JASPER_LIB) \ - $(PNG_LIB) \ - $(Z_LIB) \ - $(NEMSIO_LIB) \ - $(GFSIO_LIB4) \ - $(SIGIO_LIB4) \ - $(SFCIO_LIB4) \ - $(IP_LIB4) \ - $(SP_LIB4) \ - $(W3EMC_LIB4) \ - $(W3NCO_LIB4) \ - $(BACIO_LIB4) \ - $(CRTM_LIB) \ - $(NETCDF_LDFLAGS) - - -OBJS = wrf_io_flags.o getVariable.o getIVariableN.o \ - kinds_mod.o machine.o physcons.o \ - native_endianness.o blockIO.o \ - retrieve_index.o ZENSUN.o CLDFRAC_ZHAO.o \ - GFSPOST.o GFSPOSTSIG.o GETGBANDSCATTER.o \ - VRBLS2D_mod.o VRBLS3D_mod.o VRBLS4D_mod.o MASKS_mod.o PMICRPH.o SOIL_mod.o \ - CMASSI.o CTLBLK.o GRIDSPEC.o LOOKUP.o PARAMR.o RHGRD.o RQSTFLD.o xml_perl_data.o \ - cuparm.o params.o svptbl.o get_postfilename.o grib2_module.o \ - SET_LVLSXML.o FILL_PSETFLD.o \ - UPP_MATH.o UPP_PHYSICS.o \ - BNDLYR.o BOUND.o CALDWP.o CALDRG.o CALHEL.o CALLCL.o \ - CALMCVG.o CALPOT.o CALPW.o CALRCH.o \ - CALSTRM.o CALTAU.o CALTHTE.o CALVIS.o CALVIS_GSD.o CALVOR.o CALWXT.o \ - CALWXT_RAMER.o CALWXT_BOURG.o CALWXT_REVISED.o \ - CALWXT_EXPLICIT.o CALWXT_DOMINANT.o \ - CLDRAD.o CLMAX.o COLLECT.o COLLECT_LOC.o DEWPOINT.o \ - FDLVL.o FGAMMA.o FIXED.o FRZLVL.o FRZLVL2.o \ - GET_BITS.o INITPOST.o LFMFLD.o \ - MAPSSLP.o MISCLN.o MDL2STD_P.o MIXLEN.o MDL2P.o MDLFLD.o MPI_FIRST.o MPI_LAST.o \ - NGMFLD.o NGMSLP.o OTLFT.o OTLIFT.o SLP_new.o SLP_NMM.o EXCH.o \ - PARA_RANGE.o PROCESS.o INITPOST_NMM.o EXCH2.o \ - READCNTRL.o READ_xml.o SET_OUTFLDS.o SCLFLD.o SERVER.o SETUP_SERVERS.o \ - SMOOTH.o SURFCE.o \ - SPLINE.o TABLE.o TABLEQ.o TRPAUS.o TTBLEX.o WETBULB.o WRFPOST.o \ - CALMICT.o MICROINIT.o GPVS.o MDL2SIGMA.o \ - ETCALC.o CANRES.o CALGUST.o WETFRZLVL.o SNFRAC.o MDL2AGL.o SNFRAC_GFS.o \ - AVIATION.o DEALLOCATE.o \ - CALPBL.o MDL2SIGMA2.o INITPOST_GFS.o LFMFLD_GFS.o \ - CALRAD_WCLOUD_newcrtm.o MDL2THANDPV.o CALPBLREGIME.o POLEAVG.o \ - INITPOST_NEMS.o GETNEMSNDSCATTER.o ICAOHEIGHT.o INITPOST_GFS_NEMS.o \ - GEO_ZENITH_ANGLE.o GFIP3.o CALUPDHEL.o INITPOST_GFS_SIGIO.o \ - AllGETHERV_GSD.o MSFPS.o SELECT_CHANNELS.o ALLOCATE_ALL.o INITPOST_NEMS_MPIIO.o ASSIGNNEMSIOVAR.o \ - INITPOST_GFS_NEMS_MPIIO.o INITPOST_NETCDF.o INITPOST_GFS_NETCDF.o INITPOST_GFS_NETCDF_PARA.o \ - gtg_ctlblk.o gtg_indices.o gtg_filter.o gtg_compute.o gtg_config.o map_routines.o gtg_algo.o gtg_smoothseams.o CALVESSEL.o \ - CALHEL2.o ETAMP_Q2F.o - - -.SUFFIXES: .F .f .o .f90 .c - -.F.f: - $(CPP) $(CPPFLAGS) $< > $*.f - -$(TARGET): $(OBJST) $(OBJS) - $(FC) -o $@ $(OBJST) $(OBJS) $(LIBS) $(OPENMP) - mkdir -p include/post_4 - $(AR) $(ARFLAGS) $(LIB_TARGET) $(OBJST) $(OBJS) - mv *.mod include/post_4 - -.f.o: - $(FC) $(FFLAGS) -c $< - -.f90.o: - $(FC) $(FFLAGS) -c $< - -.c.o : - ${CC} ${CFLAGS} -c $< - - -clean: - /bin/rm -f *.o *.mod libnceppost.a ncep_post - /bin/rm -rf include