Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions sorc/ncep_post.fd/ALLOCATE_ALL.f
Original file line number Diff line number Diff line change
Expand Up @@ -1080,8 +1080,8 @@ SUBROUTINE ALLOCATE_ALL()
enddo
enddo

if (me == 0) print *,' gocart_on=',gocart_on
if (me == 0) print *,' gccpp_on=',gccpp_on
!if (me == 0) print *,' gocart_on=',gocart_on
!if (me == 0) print *,' gccpp_on=',gccpp_on
if (gocart_on .or.gccpp_on .or. nasa_on) then
!
! Add GOCART fields
Expand Down
10 changes: 5 additions & 5 deletions sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f
Original file line number Diff line number Diff line change
Expand Up @@ -1360,7 +1360,7 @@ SUBROUTINE CALRAD_WCLOUD
geometryinfo(1)%sensor_zenith_angle=sat_zenith
geometryinfo(1)%sensor_scan_angle=sat_zenith

if(i==ii .and. j==jj) then
if(i==ii .and. j==jj.and.debugprint) then
print *,'zenith info: zenith=',sat_zenith,' scan=',sat_zenith, &
' MAX_SENSOR_SCAN_ANGLE=',MAX_SENSOR_SCAN_ANGLE
endif
Expand All @@ -1370,7 +1370,7 @@ SUBROUTINE CALRAD_WCLOUD
.and. geometryinfo(1)%sensor_zenith_angle >= 0.0_r_kind)THEN
geometryinfo(1)%source_zenith_angle = acos(czen(i,j))*rtd ! solar zenith angle
geometryinfo(1)%sensor_scan_angle = 0. ! scan angle, assuming nadir
if(i==ii.and.j==jj)print*,'sample geometry ', &
if(i==ii.and.j==jj.and.debugprint)print*,'sample geometry ', &
geometryinfo(1)%sensor_zenith_angle &
,geometryinfo(1)%source_zenith_angle &
,czen(i,j)*rtd
Expand Down Expand Up @@ -1537,7 +1537,7 @@ SUBROUTINE CALRAD_WCLOUD
print*,'bad snow_depth'
end if

if(i==ii.and.j==jj)print*,'sample surface in CALRAD=', &
if(i==ii.and.j==jj.and.debugprint)print*,'sample surface in CALRAD=', &
i,j,surface(1)%wind_speed,surface(1)%water_coverage, &
surface(1)%land_coverage,surface(1)%ice_coverage, &
surface(1)%snow_coverage,surface(1)%land_temperature, &
Expand All @@ -1550,7 +1550,7 @@ SUBROUTINE CALRAD_WCLOUD

! Load atmosphere profiles into RTM model layers
! CRTM counts from top down just as post does
if(i==ii.and.j==jj)print*,'TOA= ',atmosphere(1)%level_pressure(0)
if(i==ii.and.j==jj.and.debugprint)print*,'TOA= ',atmosphere(1)%level_pressure(0)
do k = 1,lm
atmosphere(1)%cloud_fraction(k) = min(max(cfr(i,j,k),0.),1.)
atmosphere(1)%level_pressure(k) = pint(i,j,k+1)/r100
Expand Down Expand Up @@ -1732,7 +1732,7 @@ SUBROUTINE CALRAD_WCLOUD
do n=1,channelinfo(sensorindex)%n_channels
tb(i,j,n)=rtsolution(n,1)%brightness_temperature
end do
if(i==ii.and.j==jj) then
if(i==ii.and.j==jj.and.debugprint) then
do n=1,channelinfo(sensorindex)%n_channels
3303 format('Sample rtsolution(',I0,',',I0,') in CALRAD = ',F0.3)
! print 3303,n,1,rtsolution(n,1)%brightness_temperature
Expand Down
12 changes: 0 additions & 12 deletions sorc/ncep_post.fd/CALVIS_GSD.f
Original file line number Diff line number Diff line change
Expand Up @@ -311,10 +311,6 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS)
BETAV = BETAV + aextc55(i,j,lm)*1000.
endif

if (i==290 .and. j==112) then
write (6,*) 'BETAV, extcof55 =',BETAV,extcof55(i,j,lm)
end if

! Calculation of visibility based on hydrometeor and aerosols. (RH effect not yet included.)
VIS(I,J)=MIN(90.,CONST1/(BETAV+extcof55(i,j,lm))) ! max of 90km

Expand All @@ -329,16 +325,8 @@ SUBROUTINE CALVIS_GSD(CZEN,VIS)
vis_night = 1.69 * ((vis(i,j)/1.609)**0.86) * 1.609

zen_fac = min(0.1,max(czen(i,j),0.))/ 0.1
if (i==290 .and. j==112) then
write (6,*) 'zen_fac,vis_night, vis =',zen_fac,vis_night, vis(i,j)
end if

vis(i,j) = zen_fac * vis(i,j) + (1.-zen_fac)*vis_night

if (i==290 .and. j==112) then
write (6,*) 'visrh, vis =',visrh, vis(i,j)
end if

if(method == 1 .or. method == 3)then ! RH method (if lower vis)
vis(i,j) = min(vis(i,j),visrh)
endif
Expand Down
13 changes: 6 additions & 7 deletions sorc/ncep_post.fd/CLDRAD.f
Original file line number Diff line number Diff line change
Expand Up @@ -996,7 +996,6 @@ SUBROUTINE CLDRAD
endif
DELY=14259./DY_m
numr=NINT(DELY)
write (*,*) 'numr,dyval,DY_m=',numr,dyval,DY_m
DO L=LM,1,-1
DO J=JSTA,JEND
DO I=ISTA,IEND
Expand Down Expand Up @@ -1996,11 +1995,11 @@ SUBROUTINE CLDRAD
ENDDO !--- End I loop
ENDDO !--- End J loop

write(6,*)'No. pts with PBL-cloud =',npblcld
write(6,*)'No. pts to eliminate fog =',nfog
do k=2,7
write(6,*)'No. pts with fog below lev',k,' =',nfogn(k)
end do
!write(6,*)'No. pts with PBL-cloud =',npblcld
!write(6,*)'No. pts to eliminate fog =',nfog
!do k=2,7
! write(6,*)'No. pts with fog below lev',k,' =',nfogn(k)
!end do

nlifr = 0
DO J=JSTA,JEND
Expand All @@ -2009,7 +2008,7 @@ SUBROUTINE CLDRAD
if (CLDZ(i,j)>=0..and.zcld<160.) nlifr = nlifr+1
end do
end do
write(6,*)'No. pts w/ LIFR ceiling =',nlifr
!write(6,*)'No. pts w/ LIFR ceiling =',nlifr

! Parameter 408: legacy ceiling diagnostic
IF (IGET(408)>0) THEN
Expand Down
4 changes: 2 additions & 2 deletions sorc/ncep_post.fd/GEO_ZENITH_ANGLE.f
Original file line number Diff line number Diff line change
Expand Up @@ -89,8 +89,8 @@ SUBROUTINE GEO_ZENITH_ANGLE(i,j,RLAT,RLON,SLAT,SLON,ZA)
ZA = PI - E
ZA = ZA * RTD
ZA=MAX(ZA,0.)
if(abs(RLON-360.-SLON)<1. .and. abs(RLAT-30.)<1.)print*,'Debug GEO_ZENITH', &
RLON,RLAT,RES,c1,c2,a,b,c,cosd,pp,p,cose,e,ZA
!if(abs(RLON-360.-SLON)<1. .and. abs(RLAT-30.)<1.)print*,'Debug GEO_ZENITH', &
!RLON,RLAT,RES,c1,c2,a,b,c,cosd,pp,p,cose,e,ZA

RETURN
END
Expand Down
6 changes: 3 additions & 3 deletions sorc/ncep_post.fd/IFI.F
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,7 @@ subroutine send_missing_data(ient)
! The stubs always send missing data, while the actual code
! sends missing data for unsupported hours.
use CTLBLK_mod, only: ifi_nflight, ifi_flight_levels
use ctlblk_mod, only: spval, ista, iend, jsta, jend, lm, im, cfld, datapd, fld_info, ifi_flight_levels, jsta_2l, jend_2u
use ctlblk_mod, only: spval, ista, iend, jsta, jend, lm, im, cfld, datapd, fld_info, ifi_flight_levels, jsta_2l, jend_2u,me
use rqstfld_mod, only: iget, iavblfld, lvlsxml, lvls
implicit none

Expand Down Expand Up @@ -95,8 +95,8 @@ subroutine send_missing_data(ient)
if(LVLS(k,IGET(ient))>0) then
if(.not.wrote_message) then
!$OMP CRITICAL
if(.not.wrote_message) then
print '(A)', 'This post cannot produce IFI icing products because it was not compiled with libIFI.'
if(.not.wrote_message.and.me==0) then
write(*,*) 'This post cannot produce IFI icing products because it was not compiled with libIFI.'
wrote_message = .true.
endif
!$OMP END CRITICAL
Expand Down
66 changes: 32 additions & 34 deletions sorc/ncep_post.fd/INITPOST_NETCDF.f
Original file line number Diff line number Diff line change
Expand Up @@ -211,13 +211,15 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
!***********************************************************************
! START INIT HERE.
!
if(me==0)then
WRITE(6,*)'INITPOST: ENTER INITPOST_NETCDF'
WRITE(6,*)'me=',me, &
'jsta_2l=',jsta_2l,'jend_2u=', &
jend_2u,'im=',im, &
'ista_2l=',ista_2l,'iend_2u=',iend_2u, &
'ista=',ista,'iend=',iend, &
'iend_m=',iend_m
endif
!
isa = (ista+iend) / 2
jsa = (jsta+jend) / 2
Expand All @@ -238,10 +240,10 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
end if
Status=nf90_get_att(ncid3d,nf90_global,'idrt',idrt)
if(Status/=0)then
print*,'idrt not in netcdf file,reading grid'
if(me==0)print*,'idrt not in netcdf file,reading grid'
Status=nf90_get_att(ncid3d,nf90_global,'grid',varcharval)
if(Status/=0)then
print*,'idrt and grid not in netcdf file, set default to latlon'
if(me==0)print*,'idrt and grid not in netcdf file, set default to latlon'
idrt=0
MAPTYPE=0
else
Expand Down Expand Up @@ -381,8 +383,8 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
dyval=dum_const*gdsdegr
end if

print*,'lonstart,latstart,dyval,dxval', &
lonstart,lonlast,latstart,latlast,dyval,dxval
! print*,'lonstart,latstart,dyval,dxval', &
! lonstart,lonlast,latstart,latlast,dyval,dxval

! Jili Dong add support for regular lat lon (2019/03/22) end

Expand Down Expand Up @@ -459,9 +461,9 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
end if

STANDLON = cenlon
print*,'lonstart,latstart,cenlon,cenlat,truelat1,truelat2, &
stadlon,dyval,dxval', &
lonstart,latstart,cenlon,cenlat,truelat1,truelat2,standlon,dyval,dxval
! print*,'lonstart,latstart,cenlon,cenlat,truelat1,truelat2, &
! stadlon,dyval,dxval', &
! lonstart,latstart,cenlon,cenlat,truelat1,truelat2,standlon,dyval,dxval

else if(trim(varcharval)=='gaussian')then
MAPTYPE=4
Expand Down Expand Up @@ -502,7 +504,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)

Status=nf90_get_att(ncid3d,nf90_global,'nhcas',nhcas)
if(Status/=0)then
print*,'nhcas not in netcdf file, set default to nonhydro'
if(me==0) print*,'nhcas not in netcdf file, set default to nonhydro'
nhcas=0
end if
if(me==0)print*,'nhcas= ',nhcas
Expand Down Expand Up @@ -535,9 +537,9 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
else
Status=nf90_get_att(ncid3d,varid,'units',varcharval)
if(Status/=0)then
print*,'time unit not available'
if(me==0)print*,'time unit not available'
else
print*,'time unit read from netcdf file= ',varcharval
if(me==0)print*,'time unit read from netcdf file= ',varcharval
! assume use hours as unit
! idate_loc=index(varcharval,'since')+6
read(varcharval,101)idate(1),idate(2),idate(3),idate(4),idate(5)
Expand All @@ -553,7 +555,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
! end if
end if
101 format(T13,i4,1x,i2,1x,i2,1x,i2,1x,i2)
print*,'idate= ',idate(1:5)
!print*,'idate= ',idate(1:5)

! Jili Dong check output format for coordinate reading
Status=nf90_inq_varid(ncid3d,'grid_xt',varid)
Expand Down Expand Up @@ -637,7 +639,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
! Jili Dong add support for regular lat lon (2019/03/22) end

end if
print*,'lonstart,lonlast ',lonstart,lonlast
! print*,'lonstart,lonlast ',lonstart,lonlast
! Jili Dong add support for new write component output
! get latitude
if (read_lonlat) then
Expand Down Expand Up @@ -686,7 +688,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
latnw = nint(dummy(1,jm)*gdsdegr)
end if
end if
print*,'laststart,latlast = ',latstart,latlast
!print*,'laststart,latlast = ',latstart,latlast
if(debugprint)print*,'me sample gdlon gdlat= ' &
,me,gdlon(isa,jsa),gdlat(isa,jsa)

Expand Down Expand Up @@ -716,18 +718,18 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)

deallocate(glat1d,glon1d)

print*,'idate = ',(idate(i),i=1,7)
! print*,'idate = ',(idate(i),i=1,7)
! print*,'nfhour = ',nfhour

! sample print point
ii = im/2
jj = jm/2

print *,me,'max(gdlat)=', maxval(gdlat), &
'max(gdlon)=', maxval(gdlon)
! print *,me,'max(gdlat)=', maxval(gdlat), &
! 'max(gdlon)=', maxval(gdlon)
CALL EXCH(gdlat(ISTA_2L,JSTA_2L))
CALL EXCH(gdlon(ISTA_2L,JSTA_2L))
print *,'after call EXCH,me=',me
! print *,'after call EXCH,me=',me

!$omp parallel do private(i,j,ip1)
do j = jsta, jend_m
Expand Down Expand Up @@ -766,9 +768,11 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
jdate = 0
idate = 0
!
if(me==0)then
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)
endif
!
idate(1) = iyear
idate(2) = imn
Expand All @@ -784,21 +788,21 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
jdate(5) = idat(4)
jdate(6) = idat(5)
!
print *,' idate=',idate
print *,' jdate=',jdate
!print *,' idate=',idate
!print *,' jdate=',jdate
!
CALL W3DIFDAT(JDATE,IDATE,0,RINC)
!
print *,' rinc=',rinc
! print *,' rinc=',rinc
ifhr = nint(rinc(2)+rinc(1)*24.)
print *,' ifhr=',ifhr
!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
! print*,' in INITPOST ifhr ifmin fileName=',ifhr,ifmin,fileName

! Getting tstart
tstart = 0.
print*,'tstart= ',tstart
!print*,'tstart= ',tstart

! Getiing restart

Expand All @@ -814,9 +818,9 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
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
!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

! GFS does not need DT to compute accumulated fields, set it to one
Expand Down Expand Up @@ -1155,9 +1159,6 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
end do


print *, 'gocart_on=',gocart_on
print *, 'gccpp_on=',gccpp_on
print *, 'nasa_on=',nasa_on
if (gocart_on .or.gccpp_on .or. nasa_on) then

! GFS output dust in nemsio (GOCART)
Expand Down Expand Up @@ -1557,7 +1558,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
VarName='IVEGSRC'
Status=nf90_get_att(ncid2d,nf90_global,'IVEGSRC',IVEGSRC)
if (Status /= 0) then
print*,VarName,' not found-Assigned 1 for IGBP as default'
if(me==0)print*,VarName,' not found-Assigned 1 for IGBP as default'
IVEGSRC=1
end if
if (me == 0) print*,'IVEGSRC= ',IVEGSRC
Expand Down Expand Up @@ -1598,7 +1599,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
tsrfc = tprec
tmaxmin = tprec
td3d = tprec
print*,'tprec = ',tprec
!print*,'tprec = ',tprec


VarName='refl_10cm'
Expand Down Expand Up @@ -3383,9 +3384,6 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
enddo


print *, 'gocart_on=',gocart_on
print *, 'gccpp_on=',gccpp_on
print *, 'nasa_on=',nasa_on
if ((gocart_on .or. gccpp_on) .and. d2d_chem) then


Expand Down
Loading