diff --git a/sorc/ncep_post.fd/ALLOCATE_ALL.f b/sorc/ncep_post.fd/ALLOCATE_ALL.f index dc322998b..80b5edd44 100644 --- a/sorc/ncep_post.fd/ALLOCATE_ALL.f +++ b/sorc/ncep_post.fd/ALLOCATE_ALL.f @@ -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 diff --git a/sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f b/sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f index 1427b4a13..e0d346f6f 100644 --- a/sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f +++ b/sorc/ncep_post.fd/CALRAD_WCLOUD_newcrtm.f @@ -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 @@ -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 @@ -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, & @@ -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 @@ -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 diff --git a/sorc/ncep_post.fd/CALVIS_GSD.f b/sorc/ncep_post.fd/CALVIS_GSD.f index d5fabfe72..ca9028294 100644 --- a/sorc/ncep_post.fd/CALVIS_GSD.f +++ b/sorc/ncep_post.fd/CALVIS_GSD.f @@ -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 @@ -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 diff --git a/sorc/ncep_post.fd/CLDRAD.f b/sorc/ncep_post.fd/CLDRAD.f index a45e7eda1..7cbaa9bfa 100644 --- a/sorc/ncep_post.fd/CLDRAD.f +++ b/sorc/ncep_post.fd/CLDRAD.f @@ -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 @@ -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 @@ -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 diff --git a/sorc/ncep_post.fd/GEO_ZENITH_ANGLE.f b/sorc/ncep_post.fd/GEO_ZENITH_ANGLE.f index bf891921a..b0ab98bad 100644 --- a/sorc/ncep_post.fd/GEO_ZENITH_ANGLE.f +++ b/sorc/ncep_post.fd/GEO_ZENITH_ANGLE.f @@ -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 diff --git a/sorc/ncep_post.fd/IFI.F b/sorc/ncep_post.fd/IFI.F index d8d91514f..b556d326a 100644 --- a/sorc/ncep_post.fd/IFI.F +++ b/sorc/ncep_post.fd/IFI.F @@ -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 @@ -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 diff --git a/sorc/ncep_post.fd/INITPOST_NETCDF.f b/sorc/ncep_post.fd/INITPOST_NETCDF.f index 9cd756e67..32c17c0e8 100644 --- a/sorc/ncep_post.fd/INITPOST_NETCDF.f +++ b/sorc/ncep_post.fd/INITPOST_NETCDF.f @@ -211,6 +211,7 @@ 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=', & @@ -218,6 +219,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d) '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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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) @@ -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) @@ -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 @@ -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) @@ -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 @@ -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 @@ -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 @@ -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 @@ -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) @@ -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 @@ -1598,7 +1599,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d) tsrfc = tprec tmaxmin = tprec td3d = tprec - print*,'tprec = ',tprec + !print*,'tprec = ',tprec VarName='refl_10cm' @@ -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 diff --git a/sorc/ncep_post.fd/MDL2P.f b/sorc/ncep_post.fd/MDL2P.f index 660a8bc0e..abc7f9498 100644 --- a/sorc/ncep_post.fd/MDL2P.f +++ b/sorc/ncep_post.fd/MDL2P.f @@ -130,8 +130,6 @@ SUBROUTINE MDL2P(iostatusD3D) ! ! START MDL2P. ! - if(me==0) print*, 'MDL2P SMFLAG=',SMFLAG - if (modelname == 'GFS') then zero = 0.0 else @@ -3948,12 +3946,8 @@ SUBROUTINE MDL2P(iostatusD3D) ! OUTPUT MEMBRANCE SLP IF(IGET(023) > 0)THEN IF(gridtype == 'A'.OR. gridtype == 'B') then - if(me==0)PRINT*,'CALLING MEMSLP for A or B grid' CALL MEMSLP(TPRS,QPRS,FPRS) - if(me==0)PRINT*,'aft CALLING MEMSLP for A or B grid,pslp=', & - maxval(pslp(ista:iend,jsta:jend)),minval(pslp(ista:iend,jsta:jend)),pslp((ista+iend)/2,(jsta+jend)/2) ELSE IF (gridtype == 'E')THEN - if(me==0)PRINT*,'CALLING MEMSLP_NMM for E grid' ! CALL MEMSLP_NMM(TPRS,QPRS,FPRS) ELSE PRINT*,'unknow grid type-> WONT DERIVE MESINGER SLP' @@ -3982,7 +3976,6 @@ SUBROUTINE MDL2P(iostatusD3D) ! OUTPUT of MAPS SLP IF(IGET(445) > 0)THEN - if(me==0)PRINT*,'CALLING MAPS SLP' CALL MAPSSLP(TPRS) !$omp parallel do private(i,j) DO J=JSTA,JEND @@ -4080,7 +4073,6 @@ SUBROUTINE MDL2P(iostatusD3D) ! SNOW DESITY SOLID-LIQUID-RATION SLR IF ( IGET(1006)>0 ) THEN - if(me==0)PRINT*,'CALLING SLR' egrid1=spval if(slrutah_on) then call calslr_uutah(EGRID1) @@ -4118,7 +4110,6 @@ SUBROUTINE MDL2P(iostatusD3D) if(allocated(smokesl)) deallocate(smokesl) if(allocated(fv3dustsl)) deallocate(fv3dustsl) if(allocated(coarsepmsl)) deallocate(coarsepmsl) - if(me==0)PRINT*,'MDL2P completed' ! END OF ROUTINE. ! RETURN diff --git a/sorc/ncep_post.fd/MDL2THANDPV.f b/sorc/ncep_post.fd/MDL2THANDPV.f index 3f5010368..cf145dab1 100644 --- a/sorc/ncep_post.fd/MDL2THANDPV.f +++ b/sorc/ncep_post.fd/MDL2THANDPV.f @@ -80,8 +80,6 @@ SUBROUTINE MDL2THANDPV(kth,kpv,th,pv) !****************************************************************************** ! ! START MDL2TH. -! - if(me==0) write(*,*) 'MDL2THANDPV starts' ! ! SET TOTAL NUMBER OF POINTS ON OUTPUT GRID. ! @@ -364,31 +362,11 @@ SUBROUTINE MDL2THANDPV(kth,kpv,th,pv) END DO END IF - - IF(I==IM/2 .AND. J==JM/2)then - PRINT*,'SAMPLE PVETC INPUT ', & - 'p,dpdx,dpdy,tv,dtdx,dtdy,h,u,v,vort= ' - DO L=1,LM - print*,pmid(i,j,l),dum1d1(l),dum1d2(l),dum1d5(l) & - ,dum1d3(l),dum1d4(l),zmid(i,j,l),uh(i,j,l),vh(i,j,l) & - ,dum1d6(l),L - end do - end if - CALL PVETC(LM,PMID(I,J,1:LM),DUM1D1,DUM1D2 & ,DUM1D5,DUM1D3,DUM1D4,ZMID(I,J,1:LM),UH(I,J,1:LM) & ,VH(I,J,1:LM),DUM1D6 & ,DUM1D7,DUM1D8,DUM1D9,DUM1D10,DUM1D11,DUM1D12,DUM1D13)!output - IF(I==IM/2 .AND. J==JM/2)then - PRINT*,'SAMPLE PVETC OUTPUT ' & - ,'hm,s,bvf2,pvn,theta,sigma,pvu= ' - DO L=1,LM - print*,dum1d7(l),dum1d8(l),dum1d9(l),dum1d10(l),dum1d11(l) & - ,dum1d12(l),dum1d13(l),L - end do - end if - IF((IGET(332) > 0).OR.(IGET(333) > 0).OR. & (IGET(334) > 0).OR.(IGET(335) > 0).OR. & (IGET(351) > 0).OR.(IGET(352) > 0).OR. & @@ -443,31 +421,11 @@ SUBROUTINE MDL2THANDPV(kth,kpv,th,pv) & + F(I,J) END DO - IF(I==IM/2 .AND. J==JM/2)then - PRINT*,'SAMPLE PVETC INPUT for regional ', & - 'p,dpdx,dpdy,tv,dtdx,dtdy,h,u,v,vort ', & - 'JSTA_m,Jend_m, L= ' - DO L=1,LM - print*,pmid(i,j,l),dum1d1(l),dum1d2(l),dum1d5(l) & - ,dum1d3(l),dum1d4(l),zmid(i,j,l),uh(i,j,l),vh(i,j,l) & - ,dum1d6(l),JSTA_m,Jend_m,L - end do - end if - CALL PVETC(LM,PMID(I,J,1:LM),DUM1D1,DUM1D2 & ,DUM1D5,DUM1D3,DUM1D4,ZMID(I,J,1:LM),UH(I,J,1:LM) & ,VH(I,J,1:LM),DUM1D6 & ,DUM1D7,DUM1D8,DUM1D9,DUM1D10,DUM1D11,DUM1D12,DUM1D13)!output - IF(I==IM/2 .AND. J==JM/2)then - PRINT*,'SAMPLE PVETC OUTPUT ' & - ,'hm,s,bvf2,pvn,theta,sigma,pvu,pvort= ' - DO L=1,LM - print*,dum1d7(l),dum1d8(l),dum1d9(l),dum1d10(l),dum1d11(l) & - ,dum1d12(l),dum1d13(l),DUM1D6(l),L - end do - end if - IF((IGET(332) > 0).OR.(IGET(333) > 0).OR. & (IGET(334) > 0).OR.(IGET(335) > 0).OR. & (IGET(351) > 0).OR.(IGET(352) > 0).OR. & @@ -538,29 +496,11 @@ SUBROUTINE MDL2THANDPV(kth,kpv,th,pv) END DO -! IF(I==IM/2 .AND. J==JM/2)then -! PRINT*,'SAMPLE PVETC INPUT ' & -! ,'p,dpdx,dpdy,tv,dtdx,dtdy,h,u,v,vort= ' -! DO L=1,LM -! print*,pmid(i,j,l),dum1d1(l),dum1d2(l),dum1d5(l) & -! ,dum1d3(l),dum1d4(l),zmid(i,j,l),uh(i,j,l),vh(i,j,l) & -! ,dum1d6(l) -! end do -! end if - CALL PVETC(LM,PMID(I,J,1:LM),DUM1D1,DUM1D2 & ,DUM1D5,DUM1D3,DUM1D4,ZMID(I,J,1:LM),UH(I,J,1:LM) & ,VH(I,J,1:LM),DUM1D6 & ,DUM1D7,DUM1D8,DUM1D9,DUM1D10,DUM1D11,DUM1D12,DUM1D13)!output -! IF(I==IM/2 .AND. J==JM/2)then -! PRINT*,'SAMPLE PVETC OUTPUT ' & -! ,'hm,s,bvf2,pvn,theta,sigma,pvu= ' -! DO L=1,LM -! print*,dum1d7(l),dum1d8(l),dum1d9(l),dum1d10(l),dum1d11(l) & -! ,dum1d12(l),dum1d13(l) -! end do -! end if IF((IGET(332)>0).OR.(IGET(333)>0).OR. & (IGET(334)>0).OR.(IGET(335)>0).OR. & (IGET(351)>0).OR.(IGET(352)>0).OR. & @@ -615,29 +555,11 @@ SUBROUTINE MDL2THANDPV(kth,kpv,th,pv) DUM1D6(L)=DVDX-DUDY+F(I,J)+UAVG*TAN(TPHI)/ERAD !vort END DO - IF(I==IM/2 .AND. J==JM/2)then - PRINT*,'SAMPLE PVETC INPUT ' & - ,'p,dpdx,dpdy,tv,dtdx,dtdy,h,u,v,vort= ' - DO L=1,LM - print*,pmid(i,j,l),dum1d1(l),dum1d2(l),dum1d5(l) & - ,dum1d3(l),dum1d4(l),zmid(i,j,l),uh(i,j,l),vh(i,j,l) & - ,dum1d6(l) - end do - end if - CALL PVETC(LM,PMID(I,J,1:LM),DUM1D1,DUM1D2 & ,DUM1D5,DUM1D3,DUM1D4,ZMID(I,J,1:LM),UH(I,J,1:LM) & ,VH(I,J,1:LM),DUM1D6 & ,DUM1D7,DUM1D8,DUM1D9,DUM1D10,DUM1D11,DUM1D12,DUM1D13)!output - IF(I==IM/2 .AND. J==JM/2)then - PRINT*,'SAMPLE PVETC OUTPUT ' & - ,'hm,s,bvf2,pvn,theta,sigma,pvu= ' - DO L=1,LM - print*,dum1d7(l),dum1d8(l),dum1d9(l),dum1d10(l),dum1d11(l) & - ,dum1d12(l),dum1d13(l) - end do - end if IF((IGET(332) > 0).OR.(IGET(333) > 0).OR. & (IGET(334) > 0).OR.(IGET(335) > 0).OR. & (IGET(351) > 0).OR.(IGET(352) > 0).OR. & @@ -1174,7 +1096,6 @@ SUBROUTINE MDL2THANDPV(kth,kpv,th,pv) DUM1D14,wrk1, wrk2, wrk3, wrk4, cosl, dum2d) END IF ! end of selection for isentropic and constant PV fields - if(me==0) write(*,*) 'MDL2THANDPV ends' ! ! ! END OF ROUTINE. diff --git a/sorc/ncep_post.fd/MDLFLD.f b/sorc/ncep_post.fd/MDLFLD.f index 857a33858..bd4568b13 100644 --- a/sorc/ncep_post.fd/MDLFLD.f +++ b/sorc/ncep_post.fd/MDLFLD.f @@ -605,7 +605,6 @@ SUBROUTINE MDLFLD ELSE IICE = 1 END IF - PRINT*,'IICE= ',IICE ! Chuang: add convective contribution for all MP schemes RDTPHS=3.6E6/DTQ2 @@ -897,7 +896,6 @@ SUBROUTINE MDLFLD ze_smax = 10.*log10(ze_smax*1.e18) ze_gmax = 10.*log10(ze_gmax*1.e18) - write (6,*) 'dbze_max-r/s/g',ze_rmax,ze_smax,ze_gmax ENDIF !tgs endif for Thompson scheme END IF @@ -1750,7 +1748,6 @@ SUBROUTINE MDLFLD ENDIF ! ! MOISTURE CONVERGENCE ON MDL SURFACES. -! write(*,*)'iget083=',iget(083),' l=',l LLL = 0 if (IGET(083) > 0) LLL = LVLS(L,IGET(083)) IF (IGET(083)>0 .OR. IGET(295)>0) THEN @@ -3884,9 +3881,6 @@ SUBROUTINE MDLFLD EGRID6(I,J) 0)THEN if(grib=='grib2') then cfld=cfld+1 @@ -4013,7 +4001,6 @@ SUBROUTINE MDLFLD IF ( (IGET(454) > 0) ) THEN -! write(*,*) 'IM is: ', IM !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=ista,iend @@ -4024,12 +4011,6 @@ SUBROUTINE MDLFLD GRID1(I,J) = 0. ENDIF -! if ( (I >= 15 .and. I <= 17) .and. J >= 193 .and. J <= 195) then -! write(*,*) 'I,J,EGRID1(I,J) (wind speed): ', I,J, EGRID1(I,J) -! write(*,*) 'I,J,PBLH: ', I,J, EGRID4(I,J) -! write(*,*) 'I,J,GRID1 (ventilation rate): ', I,J, GRID1(I,J) -! endif - ENDDO ENDDO diff --git a/sorc/ncep_post.fd/MPI_FIRST.f b/sorc/ncep_post.fd/MPI_FIRST.f index f87de919e..b2c9e669a 100644 --- a/sorc/ncep_post.fd/MPI_FIRST.f +++ b/sorc/ncep_post.fd/MPI_FIRST.f @@ -269,8 +269,8 @@ SUBROUTINE MPI_FIRST() iup=MPI_PROC_NULL idn=MPI_PROC_NULL - if(mod(me,numx) .eq. 0) print *,' LEFT POINT',me - if(mod(me+1,numx) .eq. 0) print *,' RIGHT POINT',me + !if(mod(me,numx) .eq. 0) print *,' LEFT POINT',me + !if(mod(me+1,numx) .eq. 0) print *,' RIGHT POINT',me if(mod(me,numx) .eq. 0) ileft=MPI_PROC_NULL if(mod(me,numx) .eq. 0) ileftb=me+numx-1 if(mod(me+1,numx) .eq. 0 .or. me .eq. num_procs-1) iright=MPI_PROC_NULL @@ -278,7 +278,7 @@ SUBROUTINE MPI_FIRST() if(me .ge. numx) idn=me-numx if(me+1 .le. num_procs-numx) iup=me+numx - print 102,me,ileft,iright,iup,idn,num_procs,'GWVX BOUNDS' + !print 102,me,ileft,iright,iup,idn,num_procs,'GWVX BOUNDS' ! allocate arrays @@ -338,7 +338,7 @@ SUBROUTINE MPI_FIRST() end do ! end check code ! test pole gather - print 105,' GWVX GATHER DISP ',icnt2(me),idsp2(me),me + !print 105,' GWVX GATHER DISP ',icnt2(me),idsp2(me),me 105 format(a30,3i12) call mpi_gatherv(ipole(ista),icnt2(me),MPI_INTEGER, ipoles,icnt2,idsp2,MPI_INTEGER,0,MPI_COMM_WORLD, ierr ) @@ -362,10 +362,10 @@ SUBROUTINE MPI_FIRST() 107 format(a20,10i10) 169 format(a25,f20.1,3i10,a10,4i10) ! - print *, ' me, jsta_2l, jend_2u = ',me,jsta_2l, jend_2u, & - 'jvend_2u=',jvend_2u,'im=',im,'jm=',jm,'lm=',lm, & - 'lp1=',lp1 - write(*,'(A,5I10)') 'MPI_FIRST me,jsta,jend,ista,iend,=',me,jsta,jend,ista,iend +! print *, ' me, jsta_2l, jend_2u = ',me,jsta_2l, jend_2u, & +! 'jvend_2u=',jvend_2u,'im=',im,'jm=',jm,'lm=',lm, & +! 'lp1=',lp1 +! write(*,'(A,5I10)') 'MPI_FIRST me,jsta,jend,ista,iend,=',me,jsta,jend,ista,iend end diff --git a/sorc/ncep_post.fd/READ_xml.f b/sorc/ncep_post.fd/READ_xml.f index cfadd17a4..013cec5ca 100644 --- a/sorc/ncep_post.fd/READ_xml.f +++ b/sorc/ncep_post.fd/READ_xml.f @@ -56,15 +56,9 @@ SUBROUTINE READ_xml() ! START READCNTRL_XML HERE. ! ! READ post available field table - if (me==0) write(*,*)'in readxml,bf readxml,size(post_avblflds%param)=', & - size(post_avblflds%param) call read_postxconfig() num_post_afld=size(paramset(1)%param) num_pset=size(paramset) - if (me==0) write(*,*)'in readxml, aft read flat file.xml,num_post_afld=', & - num_post_afld - if (me==0) write(*,*)'in readxml, aft read flat file.xml,num_pset=',num_pset - ! LinGan below line removed because now we only read one flat file ! diff --git a/sorc/ncep_post.fd/SETUP_SERVERS.f b/sorc/ncep_post.fd/SETUP_SERVERS.f index f00643ec5..8dba44ab6 100644 --- a/sorc/ncep_post.fd/SETUP_SERVERS.f +++ b/sorc/ncep_post.fd/SETUP_SERVERS.f @@ -167,7 +167,7 @@ SUBROUTINE SETUP_SERVERS(MYPE, & ! istaxx = iendxx + 1 ! end do end if - print *,'mype=',mype,'icolor=',icolor +! print *,'mype=',mype,'icolor=',icolor ! ! SPLIT THE COMMUNICATOR - THE NEW INTRACOMMUNICATOR FOR ALL TASKS ! IS MPI_COMM_COMP. MPI_COMM_WORLD IS STILL AVAILABLE BUT IT DOES @@ -175,7 +175,7 @@ SUBROUTINE SETUP_SERVERS(MYPE, & ! call mpi_comm_dup(MPI_COMM_WORLD,comdup,ierr) call mpi_comm_split(comdup,icolor,mype,mpi_comm_comp,ierr) - print *,'mype=',mype,'npes=',npes,'after comm split' +! print *,'mype=',mype,'npes=',npes,'after comm split' ! ! AT THIS POINT WE HAVE A NEW COMMUNICATOR, MPI_COMM_COMP, ! THAT CAN BE USED BY THE FORECASTS TASKS AND THE I/O SERVER TASKS diff --git a/sorc/ncep_post.fd/SET_OUTFLDS.f b/sorc/ncep_post.fd/SET_OUTFLDS.f index b7ad393ee..c7482e1fd 100644 --- a/sorc/ncep_post.fd/SET_OUTFLDS.f +++ b/sorc/ncep_post.fd/SET_OUTFLDS.f @@ -76,7 +76,6 @@ SUBROUTINE SET_OUTFLDS(kth,th,kpv,pv) ! pset = paramset(npset) datset = pset%datset - if (me==0)print *,'in SET_OUTFLDS, num_pset=',num_pset,'datset=',trim(pset%datset),'npset=',npset ! ! NOW READ WHICH FIELDS ON ! WHICH LEVELS TO INTERPOLATE TO THE OUTPUT GRID. THE @@ -90,13 +89,6 @@ SUBROUTINE SET_OUTFLDS(kth,th,kpv,pv) ! This is required for flat file solution to work for nmm post_avblflds%param =>paramset(npset)%param - if (me==0) then - write(*,*)'Size of pset is: ',MFLD - write(*,*)'datset is: ',datset - write(*,*)'MXFLD is: ',MXFLD - write(*,*)'size of lvlsxml: ',size(lvlsxml) - write(*,*)'size of post_avblflds param',size(post_avblflds%param) - endif if(size(post_avblflds%param) <= 0) then write(0,*)'WRONG: post available fields not ready!!!' return @@ -153,7 +145,6 @@ SUBROUTINE SET_OUTFLDS(kth,th,kpv,pv) fld_info(i)%ntrange = 0 fld_info(i)%tinvstat = 0 enddo - if(me==0)write(*,*)'in readxml. nfld=',nfld,'nrecout=',nrecout ! ! skip creating ipv files if kth=0 and no isobaric fields are requested in ctl file ! if(kth == 0 .and. iget(013) <= 0) go to 999 @@ -179,6 +170,5 @@ SUBROUTINE SET_OUTFLDS(kth,th,kpv,pv) ! 999 CONTINUE - if(me==0)print *,'end of read_postcntrl_xml' RETURN END diff --git a/sorc/ncep_post.fd/SURFCE.f b/sorc/ncep_post.fd/SURFCE.f index 3e8383e85..d8bcf2415 100644 --- a/sorc/ncep_post.fd/SURFCE.f +++ b/sorc/ncep_post.fd/SURFCE.f @@ -5139,7 +5139,7 @@ SUBROUTINE SURFCE !-- TOTPRCP is total 1-hour accumulated precipitation in [m] totprcp = (AVGPREC_CONT(I,J)*FLOAT(IFHR)*3600./DTQ2) snowratio = 0.0 - if(graup_bucket(i,j)*1.e-3 > totprcp)then + if(graup_bucket(i,j)*1.e-3 > totprcp.and.graup_bucket(i,j)/=spval)then print *,'WARNING - Graupel is higher that total precip at point',i,j print *,'totprcp,graup_bucket(i,j),snow_bucket(i,j),rainnc_bucket',& totprcp,graup_bucket(i,j),snow_bucket(i,j),rainnc_bucket(i,j) @@ -5251,9 +5251,9 @@ SUBROUTINE SURFCE ENDDO - write (6,*)' Snow/rain ratio' - write (6,*)' max/min 1h-SNOWFALL in [cm]', & - maxval(snow_bucket)*0.1,minval(snow_bucket)*0.1 + !write (6,*)' Snow/rain ratio' + !write (6,*)' max/min 1h-SNOWFALL in [cm]', & + ! maxval(snow_bucket)*0.1,minval(snow_bucket)*0.1 DO J=JSTA,JEND DO I=ISTA,IEND @@ -5266,10 +5266,10 @@ SUBROUTINE SURFCE end do end do - write (6,*) 'Snow ratio point counts' - do icat=1,10 - write (6,*) icat, cnt_snowratio(icat) - end do + !write (6,*) 'Snow ratio point counts' + ! do icat=1,10 + !write (6,*) icat, cnt_snowratio(icat) + ! end do icnt_snow_rain_mixed = 0 DO J=JSTA,JEND @@ -5280,8 +5280,8 @@ SUBROUTINE SURFCE end do end do - write (6,*) 'No. of mixed snow/rain p-type diagnosed=', & - icnt_snow_rain_mixed + !write (6,*) 'No. of mixed snow/rain p-type diagnosed=', & + ! icnt_snow_rain_mixed ! SNOW. @@ -6713,7 +6713,7 @@ subroutine qpf_comp(igetfld,compfile,fcst) use ctlblk_mod, only: SPVAL,JSTA,JEND,IM,DTQ2,IFHR,IFMIN,TPREC,GRIB, & MODELNAME,JM,CFLD,DATAPD,FLD_INFO,JSTA_2L,JEND_2U,& - ISTA,IEND,ISTA_2L,IEND_2U + ISTA,IEND,ISTA_2L,IEND_2U,ME use rqstfld_mod, only: IGET, ID, LVLS, IAVBLFLD use grib2_module, only: read_grib2_head, read_grib2_sngle use vrbls2d, only: AVGPREC, AVGPREC_CONT @@ -6749,7 +6749,7 @@ subroutine qpf_comp(igetfld,compfile,fcst) ntot = nx*ny call read_grib2_sngle(compfile,ntot,height,mscValue) else - write(*,*) 'WARNING: FFG file not available for hour: ', fcst + if(me==0)write(*,*) 'WARNING: FFG file not available for hour: ', fcst endif ! Set GRIB variables. diff --git a/sorc/ncep_post.fd/UPP_PHYSICS.f b/sorc/ncep_post.fd/UPP_PHYSICS.f index cbec01a94..16964ce09 100644 --- a/sorc/ncep_post.fd/UPP_PHYSICS.f +++ b/sorc/ncep_post.fd/UPP_PHYSICS.f @@ -1790,8 +1790,6 @@ SUBROUTINE CALVOR(UWND,VWND,ABSV) ENDDO endif -! print*,'dyval in CALVOR= ',DYVAL - CALL EXCH(UWND) CALL EXCH(VWND) ! @@ -1841,9 +1839,6 @@ SUBROUTINE CALVOR(UWND,VWND,ABSV) call fullpole( cosl(ista_2l:iend_2u,jsta_2l:jend_2u),coslpoles) call fullpole(gdlat(ista_2l:iend_2u,jsta_2l:jend_2u),glatpoles) - if(me==0 ) print*,'CALVOR ',me,glatpoles(ista,1),glatpoles(ista,2) - if(me==num_procs-1) print*,'CALVOR ',me,glatpoles(ista,1),glatpoles(ista,2) - !$omp parallel do private(i,j,ii) DO J=JSTA,JEND if (j == 1) then @@ -2028,8 +2023,6 @@ SUBROUTINE CALVOR(UWND,VWND,ABSV) + F(I,J) ENDDO END IF -! if(ABSV(I,J)>1.0)print*,'Debug CALVOR',i,j,VWND(ip1,J),VWND(im1,J), & -! wrk2(i,j),UWND(I,J-1),COSL(I,J-1),UWND(I,J+1),COSL(I,J+1),wrk3(i,j),cosl(i,j),F(I,J),ABSV(I,J) if (npass > 0) then do i=ista,iend tx1(i) = absv(i,j) @@ -2403,11 +2396,6 @@ SUBROUTINE CALDIV(UWND,VWND,DIV) DIV(I,J,l) = ((UWND(ip1,J,l)-UWND(im1,J,l))*wrk2(i,j) & & + (VWND(I,J-1,l)*COSL(I,J-1) & - VWND(I,J+1,l)*COSL(I,J+1))*wrk3(i,j)) * wrk1(i,j) -!sk06132016 - if(DIV(I,J,l)>1.0)print*,'Debug in CALDIV',i,j,UWND(ip1,J,l),UWND(im1,J,l), & - & wrk2(i,j),VWND(I,J-1,l),COSL(I,J-1),VWND(I,J+1,l),COSL(I,J+1), & - & wrk3(i,j),wrk1(i,j),DIV(I,J,l) -!-- ENDDO ENDIF ENDDO ! end of J loop @@ -2431,10 +2419,6 @@ SUBROUTINE CALDIV(UWND,VWND,DIV) IF(JSTA== 1) DIV(ISTA:IEND, 1,L)=DIVTEMP(ISTA:IEND, 1) IF(JEND==JM) DIV(ISTA:IEND,JM,L)=DIVTEMP(ISTA:IEND,JM) -!sk06142016e - if(DIV(ista,jsta,l)>1.0)print*,'Debug in CALDIV',jsta,DIV(ista,jsta,l) -! print*,'Debug in CALDIV',' jsta= ',jsta,DIV(1,jsta,l) - enddo ! end of l looop !-- deallocate (wrk1, wrk2, wrk3, cosl, iw, ie) @@ -2663,14 +2647,6 @@ SUBROUTINE CALGRADPS(PS,PSX,PSY) im1 = iw(i) PSX(I,J) = (PS(ip1,J)-PS(im1,J))*wrk2(i,j)*wrk1(i,j) PSY(I,J) = (PS(I,J-1)-PS(I,J+1))*wrk3(i,j)/ERAD -!sk06142016A - if(PSX(I,J)>100.0)print*,'Debug in CALGRADPS: PSX',i,j,PS(ip1,J),PS(im1,J), & -! print*,'Debug in CALGRADPS',i,j,PS(ip1,J),PS(im1,J), & - & wrk2(i,j),wrk1(i,j),PSX(I,J) - if(PSY(I,J)>100.0)print*,'Debug in CALGRADPS: PSY',i,j,PS(i,J-1),PS(i,J+1), & -! print*,'Debug in CALGRADPS',i,j,PS(i,J-1),PS(i,J+1), & - & wrk3(i,j),ERAD,PSY(I,J) -!-- ENDDO END IF ! diff --git a/sorc/ncep_post.fd/WRFPOST.f b/sorc/ncep_post.fd/WRFPOST.f index 2df8a11bd..43df770a9 100644 --- a/sorc/ncep_post.fd/WRFPOST.f +++ b/sorc/ncep_post.fd/WRFPOST.f @@ -32,8 +32,9 @@ !> 2022-11-08 | K Wang | Replace aqfamaq_on with aqf_on !> 2023-01-24 | Sam Trahan | write_ifi_debug_files flag for IFI debug capability !> 2023-03-21 | Jesse Meng | Add slrutah_on option to use U Utah SLR -!> 2023-04-04 |Li(Kate Zhang) |Add namelist optoin for CCPP-Chem (UFS-Chem) +!> 2023-04-04 | Li(Kate Zhang) |Add namelist optoin for CCPP-Chem (UFS-Chem) ! and 2D diag. output (d2d_chem) for GEFS-Aerosols and CCPP-Chem model. +!> 2023-05-20 | Rahul Mahajan | Bug fix for fileNameFlat as namelist configurable !> @author Mike Bladwin NSSL/SPC @date 2002-06-18 PROGRAM WRFPOST @@ -180,8 +181,6 @@ PROGRAM WRFPOST ! IF WE HAVE MORE THAN 1 MPI TASK THEN WE WILL FIRE UP THE IO SERVER ! THE LAST TASK ( IN THE CONTEXT OF MPI_COMM_WORLD ) IS THE I/O SERVER ! - print*,'ME,NUM_PROCS,NUM_SERVERS=',ME,NUM_PROCS,NUM_SERVERS - if (me == 0) CALL W3TAGB('nems ',0000,0000,0000,'np23 ') if ( me >= num_procs ) then @@ -195,24 +194,18 @@ PROGRAM WRFPOST !KaYee: Read itag in Fortran Namelist format !Set default SUBMODELNAME='NONE' +!Set control file name + fileNameFlat='postxconfig-NT.txt' numx=1 !open namelist open(5,file='itag') read(5,nml=model_inputs,iostat=itag_ierr,err=888) - !print*,'itag_ierr=',itag_ierr 888 if (itag_ierr /= 0) then print*,'Incorrect namelist variable(s) found in the itag file,stopping!' stop endif + if (me == 0) write(6, model_inputs) - if (me==0) print*,'fileName= ',fileName - if (me==0) print*,'IOFORM= ',IOFORM - !if (me==0) print*,'OUTFORM= ',grib - if (me==0) print*,'OUTFORM= ',grib - if (me==0) print*,'DateStr= ',DateStr - if (me==0) print*,'MODELNAME= ',MODELNAME - if (me==0) print*,'SUBMODELNAME= ',SUBMODELNAME - if (me==0) print*,'numx= ',numx ! if(MODELNAME == 'NMM')then ! read(5,1114) VTIMEUNITS ! 1114 format(a4) @@ -221,9 +214,8 @@ PROGRAM WRFPOST ! 303 format('MODELNAME="',A,'" SUBMODELNAME="',A,'"') - write(*,*)'MODELNAME: ', MODELNAME, SUBMODELNAME + if(me==0) write(*,*)'MODELNAME: ', MODELNAME, SUBMODELNAME - if (me==0) print 303,MODELNAME,SUBMODELNAME ! assume for now that the first date in the stdin file is the start date read(DateStr,300) iyear,imn,iday,ihrst,imin if (me==0) write(*,*) 'in WRFPOST iyear,imn,iday,ihrst,imin', & @@ -244,16 +236,9 @@ PROGRAM WRFPOST 121 format(a4) !KaYee: Read in GFS/FV3 runs in Fortran Namelist Format. - if (me==0) print*,'MODELNAME= ',MODELNAME,'grib=',grib - if(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R') then - if (me == 0) print*,'first two file names in GFS or FV3= ' & - ,trim(fileName),trim(fileNameFlux) - end if - if(grib=='grib2') then gdsdegr = 1.d6 endif - if (me==0) print *,'gdsdegr=',gdsdegr ! ! set default for kpo, kth, th, kpv, pv kpo = 0 @@ -274,13 +259,11 @@ PROGRAM WRFPOST fileNameAER = '' rdaod = .false. d2d_chem = .false. + vtimeunits = '' -!set control file name - fileNameFlat='postxconfig-NT.txt' read(5,nampgb,iostat=iret,end=119) 119 continue - if (me==0) print*,'in itag, write_ifi_debug_files=', write_ifi_debug_files - if (me==0) print*,'in itag, mod(num_procs,numx)=', mod(num_procs,numx) + if (me == 0) write(6, nampgb) if(mod(num_procs,numx)/=0) then if (me==0) then print*,'total proces, num_procs=', num_procs @@ -355,7 +338,6 @@ PROGRAM WRFPOST end if end if LSMP1 = LSM+1 - if (me==0) print*,'LSM, SPL = ',lsm,spl(1:lsm) 116 continue @@ -369,10 +351,8 @@ PROGRAM WRFPOST if(TRIM(IOFORM) == 'netcdf' .OR. TRIM(IOFORM) == 'netcdfpara') THEN IF(MODELNAME == 'NCAR' .OR. MODELNAME == 'RAPR' .OR. MODELNAME == 'NMM') THEN 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 @@ -389,13 +369,10 @@ PROGRAM WRFPOST LM1 = LM-1 IM_JM = IM*JM - print*,'im jm lm from wrfout= ',im,jm, lm - ! Read and set global value for surface physics scheme call ext_ncd_get_dom_ti_integer(DataHandle & ,'SF_SURFACE_PHYSICS',itmp,1,ioutcount, status ) iSF_SURFACE_PHYSICS = itmp - print*,'SF_SURFACE_PHYSICS= ',iSF_SURFACE_PHYSICS ! set NSOIL to 4 as default for NOAH but change if using other ! SFC scheme NSOIL = 4 @@ -406,7 +383,6 @@ PROGRAM WRFPOST ELSE IF(itmp == 7) then ! Pleim Xu NSOIL = 2 END IF - print*,'NSOIL from wrfout= ',NSOIL call ext_ncd_ioclose ( DataHandle, Status ) ELSE @@ -438,15 +414,12 @@ PROGRAM WRFPOST print*,'nsoil not found; assigning to 4' NSOIL=4 !set nsoil to 4 for NOAH endif - if(me==0)print*,'SF_SURFACE_PHYSICS= ',iSF_SURFACE_PHYSICS - if(me==0)print*,'NSOIL= ',NSOIL ! read imp_physics Status=nf90_get_att(ncid2d,nf90_global,'imp_physics',imp_physics) if(Status/=0)then print*,'imp_physics not found; assigning to GFDL 11' imp_physics=11 endif - if (me == 0) print*,'MP_PHYSICS= ',imp_physics ! get dimesions Status = nf90_inq_dimid(ncid3d,'grid_xt',varid) if ( Status /= 0 ) then @@ -484,8 +457,6 @@ PROGRAM WRFPOST ! set NSOIL to 4 as default for NOAH but change if using other ! SFC scheme ! NSOIL = 4 - - print*,'im jm lm nsoil from fv3 output = ',im,jm,lm,nsoil END IF ELSE IF(TRIM(IOFORM) == 'binary' .OR. & @@ -499,7 +470,6 @@ PROGRAM WRFPOST spval = 9.99e20 IF(ME == 0)THEN call nemsio_init(iret=status) - print *,'nemsio_init, iret=',status call nemsio_open(nfile,trim(filename),'read',iret=status) if ( Status /= 0 ) then print*,'error opening ',fileName, ' Status = ', Status ; stop @@ -526,9 +496,7 @@ PROGRAM WRFPOST call mpi_bcast(lm, 1,MPI_INTEGER,0, mpi_comm_comp,status) call mpi_bcast(nsoil,1,MPI_INTEGER,0, mpi_comm_comp,status) - if (me == 0) print*,'im jm lm nsoil from NEMS= ',im,jm, lm ,nsoil call mpi_bcast(global,1,MPI_LOGICAL,0,mpi_comm_comp,status) - if (me == 0) print*,'Is this a global run ',global LP1 = LM+1 LM1 = LM-1 IM_JM = IM*JM @@ -560,8 +528,6 @@ PROGRAM WRFPOST CALL MPI_FIRST() - print*,'jsta,jend,jsta_m,jend_m,jsta_2l,jend_2u,spval=',jsta, & - jend,jsta_m,jend_m, jsta_2l,jend_2u,spval CALL ALLOCATE_ALL() ! @@ -592,11 +558,9 @@ PROGRAM WRFPOST IF(TRIM(IOFORM) == 'netcdf' .OR. TRIM(IOFORM) == 'netcdfpara') THEN IF(MODELNAME == 'NCAR' .OR. MODELNAME == 'RAPR') THEN - print*,'CALLING INITPOST TO PROCESS NCAR NETCDF OUTPUT' CALL INITPOST ELSE IF (MODELNAME == 'FV3R' .OR. MODELNAME == 'GFS') THEN ! use parallel netcdf library to read output directly - print*,'CALLING INITPOST_NETCDF' CALL INITPOST_NETCDF(ncid2d,ncid3d) ELSE PRINT*,'POST does not have netcdf option for model,',MODELNAME,' STOPPING,' diff --git a/sorc/ncep_post.fd/get_postfilename.f b/sorc/ncep_post.fd/get_postfilename.f index 38222918b..6949f304f 100644 --- a/sorc/ncep_post.fd/get_postfilename.f +++ b/sorc/ncep_post.fd/get_postfilename.f @@ -48,11 +48,6 @@ subroutine get_postfilename(fname) IF (KENV<=0) KENV = LEN(ENVAR) KTHR = INDEX(RESTHR,' ') -1 IF (KTHR<=0) KTHR = LEN(RESTHR) - if(me==0) print *,'PGBOUT=',trim(PGBOUT) -! - if(me==0)print *,'in get postfilename, ritehd=',ritehd,'ifhr=',ifhr,'modelname=',modelname, & - 'ENVAR(1:4)=',ENVAR(1:4),'RESTHR(1:4)=',RESTHR(1:4),'ifmin=',ifmin,'DATSET(1:KDAT)=', & - DATSET(1:KDAT) ! ! CONSTRUCT FULL PATH-FILENAME FOR OUTPUT FILE IF(MODELNAME=='GFS')THEN @@ -69,7 +64,6 @@ subroutine get_postfilename(fname) (IGET(372)>0).OR.(IGET(373)>0).OR. & (IGET(374)>0).OR.(IGET(375)>0)))THEN FNAME = D3DOUT - if(me==0)PRINT*,' FNAME FROM D3DOUT=',trim(FNAME) ELSE IF(IPVOUT(1:4)/=BLANK .AND. & index(DATSET(1:KDAT),"IPV")>0 .AND. & ((IGET(332)>0).OR.(IGET(333)>0).OR. & @@ -77,17 +71,14 @@ subroutine get_postfilename(fname) (IGET(351)>0).OR.(IGET(352)>0).OR. & (IGET(353)>0).OR.(IGET(378)>0)))THEN FNAME = IPVOUT - if(me==0)PRINT*,' FNAME FROM IPVOUT=',trim(FNAME) ELSE IF(PGBOUT(1:4)/=BLANK)THEN FNAME = PGBOUT - if(me==0)PRINT*,' FNAME FROM PGBOUT=',trim(FNAME) ELSE NDIG=MAX(LOG10(IHR+0.5)+1.,2.) ! WRITE(CFORM,'("('.GrbF',I",I1,".",I1,")")') NDIG,NDIG WRITE(CFORM,'("(I",I1,".",I1,")")') NDIG,NDIG WRITE(CFHOUR,CFORM) IHR FNAME = DATSET(1:KDAT) //'.GrbF'// CFHOUR - if(me==0)print *,' FNAME=',trim(FNAME) END IF ! IF(MODELNAME=='GFS'.AND.PGBOUT(1:4)/=BLANK)THEN ! FNAME = PGBOUT @@ -104,7 +95,6 @@ subroutine get_postfilename(fname) WRITE(CFORM,'("(I",I1,".",I1,")")') NDIG,NDIG WRITE(CFHOUR,CFORM) IHR FNAME = DATSET(1:KDAT) //'.GrbF'// CFHOUR - if(me==0)print *,' FNAME=',trim(FNAME) ! ! IF(IHR<100)THEN ! WRITE(DESCR2,1011) IHR @@ -165,9 +155,5 @@ subroutine get_postfilename(fname) ENDIF ! ENDIF - if(me==0) then - print*,'FNAME= ',trim(FNAME) - print *,'end of get post filename' - endif end subroutine get_postfilename diff --git a/sorc/ncep_post.fd/xml_perl_data.f b/sorc/ncep_post.fd/xml_perl_data.f index 5978b5208..a797cadcd 100644 --- a/sorc/ncep_post.fd/xml_perl_data.f +++ b/sorc/ncep_post.fd/xml_perl_data.f @@ -108,11 +108,7 @@ subroutine read_postxconfig() ! Take the first line as paramset_count read(22,*)paramset_count - if(me==0)write(*,*)'xml_perl_data read Post flat file' - ! Allocate paramset array size - if(me==0)write(*,*)'allocate paramset to :', paramset_count - allocate(paramset(paramset_count)) ! Take the second line as param_count (on n..1 down loop) @@ -123,14 +119,12 @@ subroutine read_postxconfig() do i = paramset_count, 1, -1 read(22,*)param_count - if(me==0)write(*,*)'allocate param to :', param_count allocate(paramset(i)%param(param_count)) ! LinGan lvlsxml is now a sum of flat file read out ! Also allocate lvlsxml for rqstfld_mod num_post_afld = num_post_afld + param_count - if(me==0)write(*,*)'sum num_post_afld :', num_post_afld end do @@ -163,7 +157,6 @@ subroutine read_postxconfig() call filter_char_inp(paramset(i)%data_type) read(22,*)paramset(i)%gen_proc_type call filter_char_inp(paramset(i)%gen_proc_type) - if(me==0)print*,'gen_proc_type= ',paramset(i)%gen_proc_type read(22,*)paramset(i)%time_range_unit call filter_char_inp(paramset(i)%time_range_unit) read(22,*)paramset(i)%orig_center @@ -177,7 +170,6 @@ subroutine read_postxconfig() call filter_char_inp(paramset(i)%field_datatype) read(22,*)paramset(i)%comprs_type call filter_char_inp(paramset(i)%comprs_type) - if(me==0)print*,'finish reading comprs_type' if(paramset(i)%gen_proc_type=='ens_fcst')then read(22,*)paramset(i)%type_ens_fcst call filter_char_inp(paramset(i)%type_ens_fcst) @@ -189,7 +181,6 @@ subroutine read_postxconfig() tmaxmin = tprec td3d = tprec end if - if(me==0)print*,'type_ens_fcst= ',paramset(i)%type_ens_fcst ! Loop param_count (param datas 161) for gfsprs do j = 1, param_count read(22,*)paramset(i)%param(j)%post_avblfldidx