From a2cbc86a97c71ce8451150582ed17e004f59a0c1 Mon Sep 17 00:00:00 2001 From: Dusan Jovic Date: Tue, 21 Mar 2023 16:11:00 +0000 Subject: [PATCH] Write all non-fatal messages to stdout instead stderr --- sorc/ncep_post.fd/CALWXT_RAMER.f | 2 +- sorc/ncep_post.fd/CLDRAD.f | 4 +-- sorc/ncep_post.fd/COLLECT_LOC.f | 8 ++--- sorc/ncep_post.fd/EXCH.f | 38 ++++++++++----------- sorc/ncep_post.fd/EXCH_c_float.f | 38 ++++++++++----------- sorc/ncep_post.fd/GFIP3.f | 6 ++-- sorc/ncep_post.fd/GFSPOST.F | 2 +- sorc/ncep_post.fd/GFSPOSTSIG.F | 22 ++++++------ sorc/ncep_post.fd/IFI.F | 8 ++--- sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f | 8 ++--- sorc/ncep_post.fd/INITPOST_NEMS.f | 24 ++++++------- sorc/ncep_post.fd/INITPOST_NETCDF.f | 6 ++-- sorc/ncep_post.fd/MDL2THANDPV.f | 4 +-- sorc/ncep_post.fd/MDLFLD.f | 16 ++++----- sorc/ncep_post.fd/MISCLN.f | 2 +- sorc/ncep_post.fd/MPI_FIRST.f | 8 ++--- sorc/ncep_post.fd/PROCESS.f | 28 +++++++-------- sorc/ncep_post.fd/READ_xml.f | 12 +++---- sorc/ncep_post.fd/SETUP_SERVERS.f | 4 +-- sorc/ncep_post.fd/SET_LVLSXML.f | 2 +- sorc/ncep_post.fd/SET_OUTFLDS.f | 20 +++++------ sorc/ncep_post.fd/SURFCE.f | 20 +++++------ sorc/ncep_post.fd/TABLE.f | 6 ++-- sorc/ncep_post.fd/WRFPOST.f | 18 +++++----- sorc/ncep_post.fd/grib2_module.f | 10 +++--- sorc/ncep_post.fd/xml_perl_data.f | 8 ++--- 26 files changed, 162 insertions(+), 162 deletions(-) diff --git a/sorc/ncep_post.fd/CALWXT_RAMER.f b/sorc/ncep_post.fd/CALWXT_RAMER.f index 5c573db20..1985c67e1 100644 --- a/sorc/ncep_post.fd/CALWXT_RAMER.f +++ b/sorc/ncep_post.fd/CALWXT_RAMER.f @@ -471,7 +471,7 @@ FUNCTION xmytw_post(t,td,p) kd = td cflag = 0 END IF - if (kd == 0.0) write(0,*)' kd=',kd,' t=',t,' p=',p,' td=',td + if (kd == 0.0) write(*,*)' kd=',kd,' t=',t,' p=',p,' td=',td ! ed = c0 - c1 * kd - c2 / kd IF (ed<-14.0.or.ed>7.0) RETURN diff --git a/sorc/ncep_post.fd/CLDRAD.f b/sorc/ncep_post.fd/CLDRAD.f index 7be48b3f9..f53190b45 100644 --- a/sorc/ncep_post.fd/CLDRAD.f +++ b/sorc/ncep_post.fd/CLDRAD.f @@ -1001,7 +1001,7 @@ SUBROUTINE CLDRAD endif DELY=14259./DY_m numr=NINT(DELY) - write (0,*) 'numr,dyval,DY_m=',numr,dyval,DY_m + write (*,*) 'numr,dyval,DY_m=',numr,dyval,DY_m DO L=LM,1,-1 DO J=JSTA,JEND DO I=ISTA,IEND @@ -1596,7 +1596,7 @@ SUBROUTINE CLDRAD ! !--- Various convective cloud base & cloud top levels ! -! write(0,*)' hbot=',hbot(i,j),' hbotd=',hbotd(i,j),' +! write(*,*)' hbot=',hbot(i,j),' hbotd=',hbotd(i,j),' ! hbots=',hbots(i,j)& ! ,' htop=',htop(i,j),' htopd=',htopd(i,j),' htops=',htops(i,j),i,j ! Initilize diff --git a/sorc/ncep_post.fd/COLLECT_LOC.f b/sorc/ncep_post.fd/COLLECT_LOC.f index bcd005242..f7056fc9f 100644 --- a/sorc/ncep_post.fd/COLLECT_LOC.f +++ b/sorc/ncep_post.fd/COLLECT_LOC.f @@ -42,7 +42,7 @@ SUBROUTINE COLLECT_LOC ( A, B ) do jj=jsxa(me),jexa(me) do ii=isxa(me),iexa(me) if(isum .gt. im*jm .or. ii .gt. im .or. ii .lt. 1 .or. jj .gt. jm .or. jj.lt. 1) & - write(0,901)' BOUNDS2 FAIL in reshape ',isum,ii,jj,im*jm,im,im*jm + write(*,901)' BOUNDS2 FAIL in reshape ',isum,ii,jj,im*jm,im,im*jm rbufs(isum)=a(ii,jj) isum=isum+1 end do @@ -60,7 +60,7 @@ SUBROUTINE COLLECT_LOC ( A, B ) do jj=jsxa(n),jexa(n) do ii=isxa(n),iexa(n) if(isum .gt. im*jm .or. ii .gt. im .or. ii .lt. 1 .or. jj .gt. jm .or. jj .lt. 1) & - write(0,901)' BOUNDS FAIL in reshape ',isum,ii,jj,im*jm,im,im*jm + write(*,901)' BOUNDS FAIL in reshape ',isum,ii,jj,im*jm,im,im*jm b(ii,jj)=buff(isum) isum=isum+1 end do @@ -106,7 +106,7 @@ SUBROUTINE COLLECT_ALL ( A, B ) do jj=jsxa(me),jexa(me) do ii=isxa(me),iexa(me) if(isum .gt. im*jm .or. ii .gt. im .or. ii .lt. 1 .or. jj .gt. jm .or. jj.lt. 1) & - write(0,901)' BOUNDS2 FAIL in reshape',isum,ii,jj,im*jm,im,im*jm + write(*,901)' BOUNDS2 FAIL in reshape',isum,ii,jj,im*jm,im,im*jm rbufs(isum)=a(ii,jj) isum=isum+1 end do @@ -122,7 +122,7 @@ SUBROUTINE COLLECT_ALL ( A, B ) do jj=jsxa(n),jexa(n) do ii=isxa(n),iexa(n) if(isum .gt. im*jm .or. ii .gt. im .or. ii .lt. 1 .or. jj .gt. jm .or. jj .lt. 1) & - write(0,901)' BOUNDS FAIL in reshape',isum,ii,jj,im*jm,im,im*jm + write(*,901)' BOUNDS FAIL in reshape',isum,ii,jj,im*jm,im,im*jm b(ii,jj)=buff(isum) isum=isum+1 end do diff --git a/sorc/ncep_post.fd/EXCH.f b/sorc/ncep_post.fd/EXCH.f index b74bd5285..5ade4380b 100644 --- a/sorc/ncep_post.fd/EXCH.f +++ b/sorc/ncep_post.fd/EXCH.f @@ -51,7 +51,7 @@ SUBROUTINE EXCH(A) jbl=max(jsta-1,1) ! -! write(0,*) 'mype=',me,'num_procs=',num_procs,'im=',im,'jsta_2l=', & +! write(*,*) 'mype=',me,'num_procs=',num_procs,'im=',im,'jsta_2l=', & ! jsta_2l,'jend_2u=',jend_2u,'jend=',jend,'iup=',iup,'jsta=', & ! jsta,'idn=',idn if ( num_procs <= 1 ) return @@ -139,7 +139,7 @@ SUBROUTINE EXCH(A) ii=ibcoords(iend+1,j)/10000 jj=ibcoords( iend+1,j)-(ii*10000) if( j .ne. jj .or. ii .ne. iend+1 .and. ii .ne. im .and. ii .ne. 1) & - write(0,921) j,iend+1,ii,jj,ibcoords(iend+1,j),'IEXCH COORD FAIL j,iend+1,ii,jj,ibcoord ' + write(*,921) j,iend+1,ii,jj,ibcoords(iend+1,j),'IEXCH COORD FAIL j,iend+1,ii,jj,ibcoord ' endif !IFIRST endif !checkcoords end do @@ -213,7 +213,7 @@ SUBROUTINE EXCH(A) ii=ibcoords(ista-1,j)/10000 jj=ibcoords( ista-1,j)-(ii*10000) if( j .ne. jj .or. ii .ne. ista-1 .and. ii .ne. im .and. ii .ne. 1) & - write(0,921) j,ista-1,ii,jj,ibcoords(ista-1,j),'EXCH COORD FAIL j,ista-1,ii,jj,ibcoord ' + write(*,921) j,ista-1,ii,jj,ibcoords(ista-1,j),'EXCH COORD FAIL j,ista-1,ii,jj,ibcoord ' endif !IFIRST endif !checkcoords end do @@ -227,7 +227,7 @@ SUBROUTINE EXCH(A) do i=ista,iend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .or. jj .ne. j) write(0,151) 'INFAILED IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .or. jj .ne. j) write(*,151) 'INFAILED IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do end do endif !IFIRST @@ -313,29 +313,29 @@ SUBROUTINE EXCH(A) ii=ibcoords(icc,jcc)/10000 jj=ibcoords(icc,jcc)-(ii*10000) - if(ii .ne. icc .and. icc .ne. 0) write(0,151) ' CORNER FAILI ilb ll ',icc,jcc,ibcoords(icc,jcc),ii,jj - if( jj .ne. jcc) write(0,151) ' CORNER FAILJ ilb ll ',icc,jcc,ibcoords(icc,jcc),ii,jj + if(ii .ne. icc .and. icc .ne. 0) write(*,151) ' CORNER FAILI ilb ll ',icc,jcc,ibcoords(icc,jcc),ii,jj + if( jj .ne. jcc) write(*,151) ' CORNER FAILJ ilb ll ',icc,jcc,ibcoords(icc,jcc),ii,jj icc=ibu jcc=jbl ii=ibcoords(icc,jcc)/10000 jj=ibcoords(icc,jcc)-(ii*10000) - if(ii .ne. icc .and. icc .ne. im+1 ) write(0,151) ' CORNER FAILI ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj - if( jj .ne. jcc ) write(0,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj + if(ii .ne. icc .and. icc .ne. im+1 ) write(*,151) ' CORNER FAILI ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj + if( jj .ne. jcc ) write(*,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj icc=ibu jcc=jbu ii=ibcoords(icc,jcc)/10000 jj=ibcoords(icc,jcc)-(ii*10000) - if(ii .ne. icc .and. icc .ne. im+1) write(0,151) ' CORNER FAILI ilb uu ',icc,jcc,ibcoords(icc,jcc),ii,jj - if( jj .ne. jcc ) write(0,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj + if(ii .ne. icc .and. icc .ne. im+1) write(*,151) ' CORNER FAILI ilb uu ',icc,jcc,ibcoords(icc,jcc),ii,jj + if( jj .ne. jcc ) write(*,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj icc=ibl jcc=jbu ii=ibcoords(icc,jcc)/10000. jj=ibcoords(icc,jcc)-(ii*10000) - if(ii .ne. icc .and. icc .ne. 0 ) write(0,151) ' CORNER FAILI ilb lu ',icc,jcc,ibcoords(icc,jcc),ii,jj - if( jj .ne. jcc ) write(0,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj + if(ii .ne. icc .and. icc .ne. 0 ) write(*,151) ' CORNER FAILI ilb lu ',icc,jcc,ibcoords(icc,jcc),ii,jj + if( jj .ne. jcc ) write(*,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj ! if(ileft .ge. 0) then !119 format(' GWX LEFT EXCHANGE ileft,me,ibcoords(ista-1,jend+1),ibcoords(ista-1,jend-1),ista-1,jend-1,jend+1', & @@ -343,7 +343,7 @@ SUBROUTINE EXCH(A) ! endif ! if(iright .ge. 0) then -!! write(0,129) iright,me,ibcoords(ista+1,jend+1),ibcoords(ista+1,jend-1),ista-1,jend-1,jend+1 !GWVX +!! write(*,129) iright,me,ibcoords(ista+1,jend+1),ibcoords(ista+1,jend-1),ista-1,jend-1,jend+1 !GWVX !129 format(' GWX RIGHT EXCHANGE iright,me,ibcoords(ista+1,jend+1),ibcoords(ista-1,jend+1),ista-1,jend-1,jend+1', & ! 10i10) ! endif @@ -354,7 +354,7 @@ SUBROUTINE EXCH(A) do i=ista,iend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .or. jj .ne. j) write(0,151) 'GWVX FAILED IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .or. jj .ne. j) write(*,151) 'GWVX FAILED IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do end do @@ -367,14 +367,14 @@ SUBROUTINE EXCH(A) do i=ista,iend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .or. jj .ne. j) write(0,151) 'GWVX FAILEDI JBU IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .or. jj .ne. j) write(*,151) 'GWVX FAILEDI JBU IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do j=jbl do i=ista,iend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .or. jj .ne. j) write(0,151) 'GWVX FAILEDI JBL IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .or. jj .ne. j) write(*,151) 'GWVX FAILEDI JBL IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do ! second and last, check left and right halo columns @@ -383,17 +383,17 @@ SUBROUTINE EXCH(A) do j=jsta,jend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .and. ii .ne. im .or. jj .ne. j) write(0,151) 'GWVX FAILED IBL IJ ',ii,i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .and. ii .ne. im .or. jj .ne. j) write(*,151) 'GWVX FAILED IBL IJ ',ii,i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do i=ibu do j=jsta,jend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .and. ii .ne. 1 .or. jj .ne. j) write(0,151) 'GWVX FAILED IBU ii i j ibcoords ibl,jbl,ibu,jbu',ii,i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .and. ii .ne. 1 .or. jj .ne. j) write(*,151) 'GWVX FAILED IBU ii i j ibcoords ibl,jbl,ibu,jbu',ii,i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do - if(me .eq. 0) write(0,*) ' IFIRST CHECK' + if(me .eq. 0) write(*,*) ' IFIRST CHECK' endif ! IFIRST endif !checkcoords diff --git a/sorc/ncep_post.fd/EXCH_c_float.f b/sorc/ncep_post.fd/EXCH_c_float.f index 8404f80f9..08c76139c 100644 --- a/sorc/ncep_post.fd/EXCH_c_float.f +++ b/sorc/ncep_post.fd/EXCH_c_float.f @@ -52,7 +52,7 @@ SUBROUTINE EXCH_c_float(A) jbl=max(jsta-1,1) ! -! write(0,*) 'mype=',me,'num_procs=',num_procs,'im=',im,'jsta_2l=', & +! write(*,*) 'mype=',me,'num_procs=',num_procs,'im=',im,'jsta_2l=', & ! jsta_2l,'jend_2u=',jend_2u,'jend=',jend,'iup=',iup,'jsta=', & ! jsta,'idn=',idn if ( num_procs <= 1 ) return @@ -140,7 +140,7 @@ SUBROUTINE EXCH_c_float(A) ii=ibcoords(iend+1,j)/10000 jj=ibcoords( iend+1,j)-(ii*10000) if( j .ne. jj .or. ii .ne. iend+1 .and. ii .ne. im .and. ii .ne. 1) & - write(0,921) j,iend+1,ii,jj,ibcoords(iend+1,j),'IEXCH COORD FAIL j,iend+1,ii,jj,ibcoord ' + write(*,921) j,iend+1,ii,jj,ibcoords(iend+1,j),'IEXCH COORD FAIL j,iend+1,ii,jj,ibcoord ' endif !IFIRST endif !checkcoords end do @@ -214,7 +214,7 @@ SUBROUTINE EXCH_c_float(A) ii=ibcoords(ista-1,j)/10000 jj=ibcoords( ista-1,j)-(ii*10000) if( j .ne. jj .or. ii .ne. ista-1 .and. ii .ne. im .and. ii .ne. 1) & - write(0,921) j,ista-1,ii,jj,ibcoords(ista-1,j),'EXCH COORD FAIL j,ista-1,ii,jj,ibcoord ' + write(*,921) j,ista-1,ii,jj,ibcoords(ista-1,j),'EXCH COORD FAIL j,ista-1,ii,jj,ibcoord ' endif !IFIRST endif !checkcoords end do @@ -228,7 +228,7 @@ SUBROUTINE EXCH_c_float(A) do i=ista,iend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .or. jj .ne. j) write(0,151) 'INFAILED IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .or. jj .ne. j) write(*,151) 'INFAILED IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do end do endif !IFIRST @@ -314,29 +314,29 @@ SUBROUTINE EXCH_c_float(A) ii=ibcoords(icc,jcc)/10000 jj=ibcoords(icc,jcc)-(ii*10000) - if(ii .ne. icc .and. icc .ne. 0) write(0,151) ' CORNER FAILI ilb ll ',icc,jcc,ibcoords(icc,jcc),ii,jj - if( jj .ne. jcc) write(0,151) ' CORNER FAILJ ilb ll ',icc,jcc,ibcoords(icc,jcc),ii,jj + if(ii .ne. icc .and. icc .ne. 0) write(*,151) ' CORNER FAILI ilb ll ',icc,jcc,ibcoords(icc,jcc),ii,jj + if( jj .ne. jcc) write(*,151) ' CORNER FAILJ ilb ll ',icc,jcc,ibcoords(icc,jcc),ii,jj icc=ibu jcc=jbl ii=ibcoords(icc,jcc)/10000 jj=ibcoords(icc,jcc)-(ii*10000) - if(ii .ne. icc .and. icc .ne. im+1 ) write(0,151) ' CORNER FAILI ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj - if( jj .ne. jcc ) write(0,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj + if(ii .ne. icc .and. icc .ne. im+1 ) write(*,151) ' CORNER FAILI ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj + if( jj .ne. jcc ) write(*,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj icc=ibu jcc=jbu ii=ibcoords(icc,jcc)/10000 jj=ibcoords(icc,jcc)-(ii*10000) - if(ii .ne. icc .and. icc .ne. im+1) write(0,151) ' CORNER FAILI ilb uu ',icc,jcc,ibcoords(icc,jcc),ii,jj - if( jj .ne. jcc ) write(0,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj + if(ii .ne. icc .and. icc .ne. im+1) write(*,151) ' CORNER FAILI ilb uu ',icc,jcc,ibcoords(icc,jcc),ii,jj + if( jj .ne. jcc ) write(*,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj icc=ibl jcc=jbu ii=ibcoords(icc,jcc)/10000. jj=ibcoords(icc,jcc)-(ii*10000) - if(ii .ne. icc .and. icc .ne. 0 ) write(0,151) ' CORNER FAILI ilb lu ',icc,jcc,ibcoords(icc,jcc),ii,jj - if( jj .ne. jcc ) write(0,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj + if(ii .ne. icc .and. icc .ne. 0 ) write(*,151) ' CORNER FAILI ilb lu ',icc,jcc,ibcoords(icc,jcc),ii,jj + if( jj .ne. jcc ) write(*,151) ' CORNER FAILJ ilb ul ',icc,jcc,ibcoords(icc,jcc),ii,jj ! if(ileft .ge. 0) then !119 format(' GWX LEFT EXCHANGE ileft,me,ibcoords(ista-1,jend+1),ibcoords(ista-1,jend-1),ista-1,jend-1,jend+1', & @@ -344,7 +344,7 @@ SUBROUTINE EXCH_c_float(A) ! endif ! if(iright .ge. 0) then -!! write(0,129) iright,me,ibcoords(ista+1,jend+1),ibcoords(ista+1,jend-1),ista-1,jend-1,jend+1 !GWVX +!! write(*,129) iright,me,ibcoords(ista+1,jend+1),ibcoords(ista+1,jend-1),ista-1,jend-1,jend+1 !GWVX !129 format(' GWX RIGHT EXCHANGE iright,me,ibcoords(ista+1,jend+1),ibcoords(ista-1,jend+1),ista-1,jend-1,jend+1', & ! 10i10) ! endif @@ -355,7 +355,7 @@ SUBROUTINE EXCH_c_float(A) do i=ista,iend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .or. jj .ne. j) write(0,151) 'GWVX FAILED IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .or. jj .ne. j) write(*,151) 'GWVX FAILED IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do end do @@ -368,14 +368,14 @@ SUBROUTINE EXCH_c_float(A) do i=ista,iend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .or. jj .ne. j) write(0,151) 'GWVX FAILEDI JBU IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .or. jj .ne. j) write(*,151) 'GWVX FAILEDI JBU IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do j=jbl do i=ista,iend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .or. jj .ne. j) write(0,151) 'GWVX FAILEDI JBL IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .or. jj .ne. j) write(*,151) 'GWVX FAILEDI JBL IJ ',i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do ! second and last, check left and right halo columns @@ -384,17 +384,17 @@ SUBROUTINE EXCH_c_float(A) do j=jsta,jend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .and. ii .ne. im .or. jj .ne. j) write(0,151) 'GWVX FAILED IBL IJ ',ii,i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .and. ii .ne. im .or. jj .ne. j) write(*,151) 'GWVX FAILED IBL IJ ',ii,i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do i=ibu do j=jsta,jend ii=ibcoords(i,j)/10000 jj=ibcoords( i,j)-(ii*10000) - if(ii .ne. i .and. ii .ne. 1 .or. jj .ne. j) write(0,151) 'GWVX FAILED IBU ii i j ibcoords ibl,jbl,ibu,jbu',ii,i,j,ibcoords(i,j),ibl,jbl,ibu,jbu + if(ii .ne. i .and. ii .ne. 1 .or. jj .ne. j) write(*,151) 'GWVX FAILED IBU ii i j ibcoords ibl,jbl,ibu,jbu',ii,i,j,ibcoords(i,j),ibl,jbl,ibu,jbu end do - if(me .eq. 0) write(0,*) ' IFIRST CHECK' + if(me .eq. 0) write(*,*) ' IFIRST CHECK' endif ! IFIRST endif !checkcoords diff --git a/sorc/ncep_post.fd/GFIP3.f b/sorc/ncep_post.fd/GFIP3.f index 01921eaa3..bcdb781ed 100644 --- a/sorc/ncep_post.fd/GFIP3.f +++ b/sorc/ncep_post.fd/GFIP3.f @@ -243,7 +243,7 @@ subroutine calc_indice(t, td, pres, wvm, nz, topoK, & real :: surfaceTemp,surfaceDewPtTemp,surfacePressure,surfaceMIXR real :: tempAtLCL, theta, pressAtLCL, thetaEAtLCL, tempFromThetaE, tem -! write(0,*)' nz=',nz,' pres=',pres(:) +! write(*,*)' nz=',nz,' pres=',pres(:) t500hPa = t(nz) t700hPa = t(nz) dpt700hPa = td(nz) @@ -254,7 +254,7 @@ subroutine calc_indice(t, td, pres, wvm, nz, topoK, & ! use linear interpolation -! write(0,*)'k=',k,' pres=',pres(k) +! write(*,*)'k=',k,' pres=',pres(k) if ((pres(k)- 50000.0 >= 0.) .and. (pres(k-1)- 50000.0 < 0.) ) then if (abs(pres(k)- 50000.0) <= 0.1) then t500hPa = t(k) @@ -280,7 +280,7 @@ subroutine calc_indice(t, td, pres, wvm, nz, topoK, & end if endif -! write(0,*)'k=',k,' pres=',pres(k),pres(k-1) +! write(*,*)'k=',k,' pres=',pres(k),pres(k-1) if ((pres(k)- 85000.0 >= 0.) .and. (pres(k-1)- 85000.0 < 0.) ) then if (abs(pres(k)- 85000.0) <= 0.1) then t850hPa = t(k) diff --git a/sorc/ncep_post.fd/GFSPOST.F b/sorc/ncep_post.fd/GFSPOST.F index c64d13b7d..5bea96158 100644 --- a/sorc/ncep_post.fd/GFSPOST.F +++ b/sorc/ncep_post.fd/GFSPOST.F @@ -537,7 +537,7 @@ subroutine mptgen(mpirank,mpisize,nd,jt1,jt2,j1,j2,jx,jm,jn) jx(n)=j2(n)-j1(n)+1 msize=msn mrank=mod(mrank,msn) - write(0,*)' mrank=',mrank,' j1=',j1(n),' j2=',j2(n),' jx=',jx(n),' jm=',jm(n) + write(*,*)' mrank=',mrank,' j1=',j1(n),' j2=',j2(n),' jx=',jx(n),' jm=',jm(n) else jm(n)=0 jn(n)=1 diff --git a/sorc/ncep_post.fd/GFSPOSTSIG.F b/sorc/ncep_post.fd/GFSPOSTSIG.F index 507fe02cd..033c04007 100644 --- a/sorc/ncep_post.fd/GFSPOSTSIG.F +++ b/sorc/ncep_post.fd/GFSPOSTSIG.F @@ -138,7 +138,7 @@ subroutine rtsig(lusig,head,k1,k2,kgds,ijo,levs,ntrac,jcap,lnt2,me, & idvm = head%idvm ! jc = omp_get_num_threads() -! write(0,*)' in RTSIG lnt2=',lnt2,' threads=',jc,' latch=',latch, & +! write(*,*)' in RTSIG lnt2=',lnt2,' threads=',jc,' latch=',latch, & ! ' jcap=',jcap,' io=',io,' jo=',jo,' ijo=',ijo ! if (k2 < k1) return @@ -191,7 +191,7 @@ subroutine rtsig(lusig,head,k1,k2,kgds,ijo,levs,ntrac,jcap,lnt2,me, & if (k2 >= k1) then klen = k2-k1+1 do k=k1,k2 - write(0,*)' retriving T for k=',k,' k1=',k1,' k2=',k2 + write(*,*)' retriving T for k=',k,' k1=',k1,' k2=',k2 dati%i = k + 2 ! Virtual Temperature or CpT dati%f => trisca(:,k) @@ -214,10 +214,10 @@ subroutine rtsig(lusig,head,k1,k2,kgds,ijo,levs,ntrac,jcap,lnt2,me, & call sptezm(0,jcap,idrt,io,jo,klen,trisca(1,k1),d(1,k1),1) ! call sptezm(0,jcap,idrt,io,jo,1,triscb,z(1,k),1) - write(0,*)' retriving d/z for k=',k,' k1=',k1,' k2=',k2 + write(*,*)' retriving d/z for k=',k,' k1=',k1,' k2=',k2 ! datm%z(3,:) = datm%z(3,:)+2*con_omega/sqrt(1.5) ! call sptezm(0,jcap,idrt,io,jo,klen,datm%z,z,1) - write(0,*)' start get tracer' + write(*,*)' start get tracer' do nt=1,ntrac do k=k1,k2 dati%i = levs * (2+nt) + 2 + k ! Tracers starting with q @@ -225,17 +225,17 @@ subroutine rtsig(lusig,head,k1,k2,kgds,ijo,levs,ntrac,jcap,lnt2,me, & call sigio_rrdati(lusig,head,dati,irets) enddo call sptezm(0,jcap,idrt,io,jo,klen,trisca(1,k1),trc(1,k1,nt),1) - write(0,*)' retriving d/z for nt=',nt,'ntrac=',ntrac,'k=',k,' k1=',k1,' k2=',k2 + write(*,*)' retriving d/z for nt=',nt,'ntrac=',ntrac,'k=',k,' k1=',k1,' k2=',k2 enddo !t=t/(1+con_fvirt*sh) - write(0,*)' end get tracer,idvm=',idvm,'ijo=',ijo,'ntrac=',ntrac + write(*,*)' end get tracer,idvm=',idvm,'ijo=',ijo,'ntrac=',ntrac ! !-- get temp if (mod(idvm/10,10) == 3) then ! Enthalpy case allocate(cpi(0:ntrac)) -! write(0,*)'aft read sig, cpi=',head%cpi +! write(*,*)'aft read sig, cpi=',head%cpi cpi(0:ntrac) = head%cpi(1:ntrac+1) -! write(0,*)'cpi=',cpi(0:ntrac) +! write(*,*)'cpi=',cpi(0:ntrac) !$omp parallel do private(k,i,xcp,sumq,n) do k=k1,k2 do i=1,ijo @@ -261,7 +261,7 @@ subroutine rtsig(lusig,head,k1,k2,kgds,ijo,levs,ntrac,jcap,lnt2,me, & enddo endif endif -! write(0,*)'end comput t' +! write(*,*)'end comput t' iret=0 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - end subroutine @@ -405,8 +405,8 @@ subroutine modstuff2(im,ix,km,idvc,idsl,nvcoord,vcoord,ps,psx,psy,d,u,v,& ! ! if (me == 0) then -! write(0,*)' pd8=',pd8(1,60:64) -! write(0,*)' pm8=',pm8(1,60:64) +! write(*,*)' pd8=',pd8(1,60:64) +! write(*,*)' pm8=',pm8(1,60:64) ! endif !jw: has to be 8 real for wam diff --git a/sorc/ncep_post.fd/IFI.F b/sorc/ncep_post.fd/IFI.F index 2b910cc99..46b547079 100644 --- a/sorc/ncep_post.fd/IFI.F +++ b/sorc/ncep_post.fd/IFI.F @@ -59,7 +59,7 @@ subroutine send_missing_data(ient) return endif - write(0,*) 'ient,iget = ',ient,iget(ient) + write(*,*) 'ient,iget = ',ient,iget(ient) if(IGET(ient)<1 .or. IGET(ient)>size(LVLS,2)) then return @@ -1036,7 +1036,7 @@ subroutine write_fip_output(ifi_data,fcst_lead_sec,output_file,rename,z2dname,z3 type(var_info),target :: var_data(maxvars) if(me==0) then - write(0,'(A,A)') trim(output_file),': writing IFI debug data' + write(*,'(A,A)') trim(output_file),': writing IFI debug data' endif call ifi_check(ifi_data%get_dims(ids,ide, jds,jde, kds,kde, ips,ipe, jps,jpe, kps,kpe),"get_dims") @@ -1096,13 +1096,13 @@ subroutine write_fip_output(ifi_data,fcst_lead_sec,output_file,rename,z2dname,z3 nvars=ivar if(nvars<1) then - write(0,"(A,A)") output_file,': no data to write!' + write(*,"(A,A)") output_file,': no data to write!' return endif call nc_check(nf90_enddef(ncid),output_file,'nf90_enddef') - write(0,*) 'before write loop ',me + write(*,*) 'before write loop ',me do ivar=1,nvars 24 format(' put var ',A) print 24,trim(var_data(ivar)%varname) diff --git a/sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f b/sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f index 2452b2f8d..e55cae454 100644 --- a/sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f +++ b/sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f @@ -237,7 +237,7 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER) end do end do -! write(0,*)'nrec=',nrec +! write(*,*)'nrec=',nrec allocate(recname(nrec),reclevtyp(nrec),reclev(nrec)) allocate(glat1d(im*jm),glon1d(im*jm)) allocate(vcoord4(lm+1,3,2)) @@ -1156,7 +1156,7 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER) vcrd, pint(1,j,lp1), psx2d(1,j), psy2d(1,j), & d2d, u2d, v2d, pi2d, pm2d, omga2d, me) ! if (j ==1 .or. j == jm) & -! write (0,*)' omga2d=',omga2d(1,:),' j=',j +! write (*,*)' omga2d=',omga2d(1,:),' j=',j if (npass <= 0 ) then !$omp parallel do private(i,l,ll) @@ -1198,7 +1198,7 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER) ! Average omega for the last point near the poles - moorthi if (j ==1 .or. j == jm) then tx1 = 1.0 / im -! write(0,*)' j=',j,' omgamax=',maxval(omga(:,j,:)),' omgamin=',minval(omga(:,j,:)) +! write(*,*)' j=',j,' omgamax=',maxval(omga(:,j,:)),' omgamin=',minval(omga(:,j,:)) !$omp parallel do private(i,l,tx2) do l=1,lm tx2 = 0.0 @@ -1898,7 +1898,7 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER) 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) +! write(*,*)' 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 diff --git a/sorc/ncep_post.fd/INITPOST_NEMS.f b/sorc/ncep_post.fd/INITPOST_NEMS.f index a88dfa3d6..5f3978251 100644 --- a/sorc/ncep_post.fd/INITPOST_NEMS.f +++ b/sorc/ncep_post.fd/INITPOST_NEMS.f @@ -1927,25 +1927,25 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) END DO if (me==0) then print*,'finish deriving geopotential in nmm' - write(0,*)' after ZINT lm=',lm,' js=',js,' je=',je,' im=',im - write(0,*)' zmid lbounds=',lbound(zmid),' ubounds=',ubound(zmid) - write(0,*)' zint lbounds=',lbound(zint),' ubounds=',ubound(zint) - write(0,*)' pmid lbounds=',lbound(pmid),' ubounds=',ubound(pmid) - write(0,*)' pint lbounds=',lbound(pint),' ubounds=',ubound(pint) + write(*,*)' after ZINT lm=',lm,' js=',js,' je=',je,' im=',im + write(*,*)' zmid lbounds=',lbound(zmid),' ubounds=',ubound(zmid) + write(*,*)' zint lbounds=',lbound(zint),' ubounds=',ubound(zint) + write(*,*)' pmid lbounds=',lbound(pmid),' ubounds=',ubound(pmid) + write(*,*)' pint lbounds=',lbound(pint),' ubounds=',ubound(pint) endif deallocate(fi) ! DO L=1,LM -! write(0,*)' zmid l=',l +! write(*,*)' zmid l=',l !$omp parallel do private(i,j,fact) DO J=Jsta,Jend -! write(0,*)' zmid j=',j +! write(*,*)' zmid j=',j DO I=1,IM -! write(0,*)' zmid i=',i +! write(*,*)' zmid i=',i ! ZMID(I,J,L)=(ZINT(I,J,L+1)+ZINT(I,J,L))*0.5 ! ave of z -! write(0,*)' pmid=',pmid(i,j,l) -! write(0,*)' pint=',pint(i,j,l),pint(i,j,l+1) -! write(0,*)' zint=',zint(i,j,l),zint(i,j,l+1) +! write(*,*)' pmid=',pmid(i,j,l) +! write(*,*)' pint=',pint(i,j,l),pint(i,j,l+1) +! write(*,*)' zint=',zint(i,j,l),zint(i,j,l+1) FACT = (LOG(PMID(I,J,L))-LOG(PINT(I,J,L))) & / (LOG(PINT(I,J,L+1))-LOG(PINT(I,J,L))) ZMID(I,J,L) = ZINT(I,J,L) + (ZINT(I,J,L+1)-ZINT(I,J,L))*FACT @@ -2828,7 +2828,7 @@ SUBROUTINE INITPOST_NEMS(NREC,nfile) ! close all files call nemsio_close(nfile,iret=status) ! - if(me==0)write(0,*)'end of INIT_NEMS' + if(me==0)write(*,*)'end of INIT_NEMS' RETURN END diff --git a/sorc/ncep_post.fd/INITPOST_NETCDF.f b/sorc/ncep_post.fd/INITPOST_NETCDF.f index 0348e13cb..e66586721 100644 --- a/sorc/ncep_post.fd/INITPOST_NETCDF.f +++ b/sorc/ncep_post.fd/INITPOST_NETCDF.f @@ -516,7 +516,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d) 'hypres', 'clwmr','dpres'] endif -! write(0,*)'nrec=',nrec +! write(*,*)'nrec=',nrec !allocate(recname(nrec),reclevtyp(nrec),reclev(nrec)) allocate(glat1d(jm),glon1d(im)) @@ -900,7 +900,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d) iret = nf90_inq_varid(ncid2d,'cldfra',varid) if(iret_bl==NF90_NOERR .and. iret==NF90_NOERR) then - write(0,*) 'WARNING: BOTH cldfra_bl AND cldfra ARE AVAILABLE. USING cldfra.' + write(*,*) 'WARNING: BOTH cldfra_bl AND cldfra ARE AVAILABLE. USING cldfra.' VarName='cldfra' else if(iret_bl==NF90_NOERR) then VarName='cldfra_bl' @@ -1724,7 +1724,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d) do j=jsta,jend do i=ista,iend if (ths(i,j) /= spval) then -! write(0,*)' i=',i,' j=',j,' ths=',ths(i,j),' pint=',pint(i,j,lp1) +! write(*,*)' 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 diff --git a/sorc/ncep_post.fd/MDL2THANDPV.f b/sorc/ncep_post.fd/MDL2THANDPV.f index 8d70c2ee4..71dbba413 100644 --- a/sorc/ncep_post.fd/MDL2THANDPV.f +++ b/sorc/ncep_post.fd/MDL2THANDPV.f @@ -73,7 +73,7 @@ SUBROUTINE MDL2THANDPV(kth,kpv,th,pv) ! ! START MDL2TH. ! - if(me==0) write(0,*) 'MDL2THANDPV starts' + if(me==0) write(*,*) 'MDL2THANDPV starts' ! ! SET TOTAL NUMBER OF POINTS ON OUTPUT GRID. ! @@ -1166,7 +1166,7 @@ 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(0,*) 'MDL2THANDPV ends' + 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 13f6a1ef7..254066744 100644 --- a/sorc/ncep_post.fd/MDLFLD.f +++ b/sorc/ncep_post.fd/MDLFLD.f @@ -1750,7 +1750,7 @@ SUBROUTINE MDLFLD ENDIF ! ! MOISTURE CONVERGENCE ON MDL SURFACES. -! write(0,*)'iget083=',iget(083),' l=',l +! 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 @@ -3885,7 +3885,7 @@ SUBROUTINE MDLFLD UH(I,J,1) 0)THEN if(grib=='grib2') then cfld=cfld+1 @@ -4013,7 +4013,7 @@ SUBROUTINE MDLFLD IF ( (IGET(454) > 0) ) THEN -! write(0,*) 'IM is: ', IM +! write(*,*) 'IM is: ', IM !$omp parallel do private(i,j) DO J=JSTA,JEND DO I=ista,iend @@ -4025,9 +4025,9 @@ SUBROUTINE MDLFLD ENDIF ! if ( (I >= 15 .and. I <= 17) .and. J >= 193 .and. J <= 195) then -! write(0,*) 'I,J,EGRID1(I,J) (wind speed): ', I,J, EGRID1(I,J) -! write(0,*) 'I,J,PBLH: ', I,J, EGRID4(I,J) -! write(0,*) 'I,J,GRID1 (ventilation rate): ', I,J, GRID1(I,J) +! 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 diff --git a/sorc/ncep_post.fd/MISCLN.f b/sorc/ncep_post.fd/MISCLN.f index eabd6d042..5a023da48 100644 --- a/sorc/ncep_post.fd/MISCLN.f +++ b/sorc/ncep_post.fd/MISCLN.f @@ -3710,7 +3710,7 @@ SUBROUTINE MISCLN iget2 = LVLS(1,iget1) iget3 = LVLS(2,iget1) endif - if(me==0) write(0,*) '953 ',iget1,iget2,iget3 + if(me==0) write(*,*) '953 ',iget1,iget2,iget3 IF (iget1 > 0 .OR. IGET(162) > 0 .OR. IGET(953) > 0) THEN DEPTH(1) = 3000.0 DEPTH(2) = 1000.0 diff --git a/sorc/ncep_post.fd/MPI_FIRST.f b/sorc/ncep_post.fd/MPI_FIRST.f index 0484cd257..e28472850 100644 --- a/sorc/ncep_post.fd/MPI_FIRST.f +++ b/sorc/ncep_post.fd/MPI_FIRST.f @@ -112,7 +112,7 @@ SUBROUTINE MPI_FIRST() isumm2=0 if ( me == 0 ) then - write(0,*) ' NUM_PROCS,NUMX,NUMY = ',num_procs,numx,num_procs/numx + write(*,*) ' NUM_PROCS,NUMX,NUMY = ',num_procs,numx,num_procs/numx end if if ( num_procs > 1024 ) then @@ -345,10 +345,10 @@ SUBROUTINE MPI_FIRST() ii=rpoles(i,j)/4000 jj=rpoles(i,j) -ii*4000 if(ii .ne. i .or. jj .ne. 1 .and. jj .ne. jm ) then - write(0,169)' IPOLES BAD POINT',rpoles(i,j),ii,i,jj,' jm= ',jm + write(*,169)' IPOLES BAD POINT',rpoles(i,j),ii,i,jj,' jm= ',jm else continue -! write(0,169)' IPOLES GOOD POINT',rpoles(i,j),ii,i,jj,' jm= ',jm +! write(*,169)' IPOLES GOOD POINT',rpoles(i,j),ii,i,jj,' jm= ',jm endif end do end do @@ -360,7 +360,7 @@ SUBROUTINE MPI_FIRST() print *, ' me, jsta_2l, jend_2u = ',me,jsta_2l, jend_2u, & 'jvend_2u=',jvend_2u,'im=',im,'jm=',jm,'lm=',lm, & 'lp1=',lp1 - write(0,'(A,5I10)') 'MPI_FIRST me,jsta,jend,ista,iend,=',me,jsta,jend,ista,iend + write(*,'(A,5I10)') 'MPI_FIRST me,jsta,jend,ista,iend,=',me,jsta,jend,ista,iend end diff --git a/sorc/ncep_post.fd/PROCESS.f b/sorc/ncep_post.fd/PROCESS.f index 1f0423a68..1aa722be7 100644 --- a/sorc/ncep_post.fd/PROCESS.f +++ b/sorc/ncep_post.fd/PROCESS.f @@ -54,45 +54,45 @@ SUBROUTINE PROCESS(kth,kpv,th,pv,iostatusD3D) ! START SUBROUTINE PROCESS. ! cfld=0 - if(me==0) write(0,*) "PROCESS starts" + if(me==0) write(*,*) "PROCESS starts" ! ! COMPUTE/POST FIELDS ON MDL SURFACES. ! btim = mpi_wtime() CALL MDLFLD - if(me==0) write(0,*) "PROCESS MDLFLD done" + if(me==0) write(*,*) "PROCESS MDLFLD done" ETAFLD2_tim = ETAFLD2_tim +(mpi_wtime() - btim) ! ! COMPUTE/POST FIELDS ON PRESSURE SURFACES. btim = mpi_wtime() CALL MDL2P(iostatusD3D) - if(me==0) write(0,*) "PROCESS MDL2P done" + if(me==0) write(*,*) "PROCESS MDL2P done" ETA2P_tim = ETA2P_tim +(mpi_wtime() - btim) ! ! COMPUTE/POST FIELDS ON SIGMA SURFACES. btim = mpi_wtime() CALL MDL2SIGMA - if(me==0) write(0,*) "PROCESS MDL2SIGMA done" + if(me==0) write(*,*) "PROCESS MDL2SIGMA done" CALL MDL2SIGMA2 - if(me==0) write(0,*) "PROCESS MDL2SIGMA2 done" + if(me==0) write(*,*) "PROCESS MDL2SIGMA2 done" MDL2SIGMA_tim = MDL2SIGMA_tim +(mpi_wtime() - btim) ! ! COMPUTE/POST FIELDS ON AGL SURFCES. btim = mpi_wtime() CALL MDL2AGL - if(me==0) write(0,*) "PROCESS MDL2AGL done" + if(me==0) write(*,*) "PROCESS MDL2AGL done" MDL2AGL_tim = MDL2AGL_tim +(mpi_wtime() - btim) ! ! COMPUTE/POST SURFACE RELATED FIELDS. btim = mpi_wtime() CALL SURFCE - if(me==0) write(0,*) "PROCESS SURFCE done" + if(me==0) write(*,*) "PROCESS SURFCE done" SURFCE2_tim = SURFCE2_tim +(mpi_wtime() - btim) ! ! COMPUTE/POST SOUNDING AND CLOUD RELATED FIELDS. btim = mpi_wtime() CALL CLDRAD - if(me==0) write(0,*) "PROCESS CLDRAD done" + if(me==0) write(*,*) "PROCESS CLDRAD done" CLDRAD_tim = CLDRAD_tim +(mpi_wtime() - btim) ! ! COMPUTE/POST TROPOPAUSE DATA, FD LEVEL FIELDS, @@ -100,7 +100,7 @@ SUBROUTINE PROCESS(kth,kpv,th,pv,iostatusD3D) ! AND LFM-NGM LOOK-ALIKE FIELDS. btim = mpi_wtime() CALL MISCLN - if(me==0) write(0,*) "PROCESS MISCLN done" + if(me==0) write(*,*) "PROCESS MISCLN done" MISCLN_tim = MISCLN_tim +(mpi_wtime() - btim) ! COMPUTE/POST TROPOPAUSE DATA, FD LEVEL FIELDS, @@ -108,25 +108,25 @@ SUBROUTINE PROCESS(kth,kpv,th,pv,iostatusD3D) ! AND LFM-NGM LOOK-ALIKE FIELDS. btim = mpi_wtime() CALL MDL2STD_P - if(me==0) write(0,*) "PROCESS MDL2STD_P done" + if(me==0) write(*,*) "PROCESS MDL2STD_P done" MDL2STD_tim = MDL2STD_tim +(mpi_wtime() - btim) ! ! POST FIXED FIELDS. btim = mpi_wtime() CALL FIXED - if(me==0) write(0,*) "PROCESS FIXED done" + if(me==0) write(*,*) "PROCESS FIXED done" FIXED_tim = FIXED_tim +(mpi_wtime() - btim) ! ! COMPUTE/POST FIELDS ON SIGMA SURFACES. btim = mpi_wtime() CALL MDL2THANDPV(kth,kpv,th,pv) - if(me==0) write(0,*) "PROCESS MDL2THANDPV done" + if(me==0) write(*,*) "PROCESS MDL2THANDPV done" MDL2THANDPV_tim = MDL2THANDPV_tim +(mpi_wtime() - btim) ! ! POST RADIANCE AND BRIGHTNESS FIELDS. btim = mpi_wtime() CALL CALRAD_WCLOUD - if(me==0) write(0,*) "PROCESS CALRAD_WCLOUD done" + if(me==0) write(*,*) "PROCESS CALRAD_WCLOUD done" CALRAD_WCLOUD_tim = CALRAD_WCLOUD_tim +(mpi_wtime() - btim) ! ! IN-FLIGHT ICING PRODUCTS @@ -138,7 +138,7 @@ SUBROUTINE PROCESS(kth,kpv,th,pv,iostatusD3D) ! NTLFLD=cfld if(me==0)print *,'nTLFLD=',NTLFLD - if(me==0) write(0,*) "PROCESS done" + if(me==0) write(*,*) "PROCESS done" ! RETURN END diff --git a/sorc/ncep_post.fd/READ_xml.f b/sorc/ncep_post.fd/READ_xml.f index 843770d70..cfadd17a4 100644 --- a/sorc/ncep_post.fd/READ_xml.f +++ b/sorc/ncep_post.fd/READ_xml.f @@ -56,14 +56,14 @@ SUBROUTINE READ_xml() ! START READCNTRL_XML HERE. ! ! READ post available field table - if (me==0) write(0,*)'in readxml,bf readxml,size(post_avblflds%param)=', & + 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(0,*)'in readxml, aft read flat file.xml,num_post_afld=', & + if (me==0) write(*,*)'in readxml, aft read flat file.xml,num_post_afld=', & num_post_afld - if (me==0) write(0,*)'in readxml, aft read flat file.xml,num_pset=',num_pset + 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 @@ -72,15 +72,15 @@ SUBROUTINE READ_xml() ! call read_xml_file_post_t( 'post_avblflds.xml') ! num_post_afld=size(post_avblflds%param) ! allocate(lvlsxml(MXLVL,num_post_afld)) -! write(0,*)'in readxml, aft read post_avblflds.xml,num_post_afld=',num_post_afld +! write(*,*)'in readxml, aft read post_avblflds.xml,num_post_afld=',num_post_afld ! endif ! ! READ post cntrl file -! write(0,*)'in readxml,bf readxml,size(paramset)=',size(paramset) +! write(*,*)'in readxml,bf readxml,size(paramset)=',size(paramset) ! if(size(paramset)==0) then ! call read_xml_file_post_t( 'postcntrl.xml') ! num_pset=size(paramset) -! write(0,*)'in readxml, aft read postcntrl.xml,num_pset=',num_pset +! write(*,*)'in readxml, aft read postcntrl.xml,num_pset=',num_pset ! endif ! diff --git a/sorc/ncep_post.fd/SETUP_SERVERS.f b/sorc/ncep_post.fd/SETUP_SERVERS.f index 8acd4332b..f00643ec5 100644 --- a/sorc/ncep_post.fd/SETUP_SERVERS.f +++ b/sorc/ncep_post.fd/SETUP_SERVERS.f @@ -45,9 +45,9 @@ SUBROUTINE SETUP_SERVERS(MYPE, & ! call mpi_init(ierr) call mpi_comm_rank(MPI_COMM_WORLD,mype,ierr) - write(0,*)' mype=',mype,' ierr=',ierr + write(*,*)' mype=',mype,' ierr=',ierr call mpi_comm_size(MPI_COMM_WORLD,npes,ierr) - write(0,*)' npes=',npes,' ierr=',ierr + write(*,*)' npes=',npes,' ierr=',ierr ! ! SPECIFY ONE I/O SERVER AS LONG AS THERE ARE MORE THAN 1 MPI TASK ! diff --git a/sorc/ncep_post.fd/SET_LVLSXML.f b/sorc/ncep_post.fd/SET_LVLSXML.f index 3073aeb4e..6cd00d45a 100644 --- a/sorc/ncep_post.fd/SET_LVLSXML.f +++ b/sorc/ncep_post.fd/SET_LVLSXML.f @@ -202,7 +202,7 @@ subroutine SET_LVLSXML(param,ifld,irec,kpv,pv,kth,th) endif enddo iloop411 if(.not.found) then - write(0,*) 'ERROR: No such IFI flight level: ',param%level(j)/10 + write(*,*) 'ERROR: No such IFI flight level: ',param%level(j)/10 LVLS(i,ifld)=0 endif enddo diff --git a/sorc/ncep_post.fd/SET_OUTFLDS.f b/sorc/ncep_post.fd/SET_OUTFLDS.f index a21f98fa5..b7ad393ee 100644 --- a/sorc/ncep_post.fd/SET_OUTFLDS.f +++ b/sorc/ncep_post.fd/SET_OUTFLDS.f @@ -91,11 +91,11 @@ SUBROUTINE SET_OUTFLDS(kth,th,kpv,pv) post_avblflds%param =>paramset(npset)%param if (me==0) then - write(0,*)'Size of pset is: ',MFLD - write(0,*)'datset is: ',datset - write(0,*)'MXFLD is: ',MXFLD - write(0,*)'size of lvlsxml: ',size(lvlsxml) - write(0,*)'size of post_avblflds param',size(post_avblflds%param) + 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!!!' @@ -115,8 +115,8 @@ SUBROUTINE SET_OUTFLDS(kth,th,kpv,pv) FOUND_FLD = .false. -! write(0,*)'cntfile,i=',i,'fld shortname=',trim(pset%param(i)%shortname) -! write(0,*)'size(post_avblflds%param)=',size(post_avblflds%param) +! write(*,*)'cntfile,i=',i,'fld shortname=',trim(pset%param(i)%shortname) +! write(*,*)'size(post_avblflds%param)=',size(post_avblflds%param) IFLD = IFLD + 1 @@ -153,7 +153,7 @@ SUBROUTINE SET_OUTFLDS(kth,th,kpv,pv) fld_info(i)%ntrange = 0 fld_info(i)%tinvstat = 0 enddo - if(me==0)write(0,*)'in readxml. nfld=',nfld,'nrecout=',nrecout + 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 @@ -167,10 +167,10 @@ SUBROUTINE SET_OUTFLDS(kth,th,kpv,pv) ! DO 50 IFLD = 1,NFLD ! IF(ME==0)THEN ! i=IAVBLFLD(IFLD) -! write(0,*)'readxml,ifld=',ifld,'iget(',IDENT(ifld),')=',iget(ident(ifld)),'iavbl=',IAVBLFLD(iget(ident(ifld))),'postvar=',trim(pset%param(i)%pname), & +! write(*,*)'readxml,ifld=',ifld,'iget(',IDENT(ifld),')=',iget(ident(ifld)),'iavbl=',IAVBLFLD(iget(ident(ifld))),'postvar=',trim(pset%param(i)%pname), & ! trim(pset%param(i)%fixed_sfc1_type),'lvls=',LVLS(:,ifld) ! if(size(pset%param(i)%level)>0) then -! WRITE(0,*) pset%param(i)%level +! WRITE(*,*) pset%param(i)%level ! endif ! ENDIF ! 50 CONTINUE diff --git a/sorc/ncep_post.fd/SURFCE.f b/sorc/ncep_post.fd/SURFCE.f index 84f8c2201..fba06308f 100644 --- a/sorc/ncep_post.fd/SURFCE.f +++ b/sorc/ncep_post.fd/SURFCE.f @@ -1018,7 +1018,7 @@ SUBROUTINE SURFCE ! ONLY OUTPUT NEW LSM FIELDS FOR NMM AND ARW BECAUSE RSM USES OLD SOIL TYPES IF (MODELNAME == 'NCAR'.OR. MODELNAME == 'NMM' & .OR. MODELNAME == 'FV3R' .OR. MODELNAME == 'RAPR') THEN -! write(0,*)'in surf,isltyp=',maxval(isltyp(1:im,jsta:jend)), & +! write(*,*)'in surf,isltyp=',maxval(isltyp(1:im,jsta:jend)), & ! minval(isltyp(1:im,jsta:jend)),'qwbs=',maxval(qwbs(1:im,jsta:jend)), & ! minval(qwbs(1:im,jsta:jend)),'potsvp=',maxval(potevp(1:im,jsta:jend)), & ! minval(potevp(1:im,jsta:jend)),'sno=',maxval(sno(1:im,jsta:jend)), & @@ -4533,7 +4533,7 @@ SUBROUTINE SURFCE freezr(ista:iend,jsta:jend,nalg), snow(ista:iend,jsta:jend,nalg)) allocate(zwet(ista:iend,jsta:jend)) CALL CALWXT_POST(T,Q,PMID,PINT,HTM,LMH,PREC,ZINT,IWX1,ZWET) -! write(0,*)' after first CALWXT_POST' +! write(*,*)' after first CALWXT_POST' IF (IGET(160)>0) THEN @@ -4603,12 +4603,12 @@ SUBROUTINE SURFCE ! BOURGOUIN ALGORITHM ISEED=44641*(INT(SDAT(1)-1)*24*31+INT(SDAT(2))*24+IHRST)+ & & MOD(IFHR*60+IFMIN,44641)+4357 -! write(0,*)'in SURFCE,me=',me,'bef 1st CALWXT_BOURG_POST iseed=',iseed +! write(*,*)'in SURFCE,me=',me,'bef 1st CALWXT_BOURG_POST iseed=',iseed CALL CALWXT_BOURG_POST(IM,ISTA_2L,IEND_2U,ISTA,IEND,JM,JSTA_2L,JEND_2U,JSTA,JEND,LM,LP1,& & ISEED,G,PTHRESH, & & T,Q,PMID,PINT,LMH,PREC,ZINT,IWX1,me) -! write(0,*)'in SURFCE,me=',me,'aft 1st CALWXT_BOURG_POST' -! write(0,*)'in SURFCE,me=',me,'IWX1=',IWX1(1:30,JSTA),'PTHRESH=',PTHRESH +! write(*,*)'in SURFCE,me=',me,'aft 1st CALWXT_BOURG_POST' +! write(*,*)'in SURFCE,me=',me,'IWX1=',IWX1(1:30,JSTA),'PTHRESH=',PTHRESH ! DECOMPOSE IWX1 ARRAY ! @@ -4787,7 +4787,7 @@ SUBROUTINE SURFCE ENDDO ENDDO if (allocated(zwet)) deallocate(zwet) -! write(0,*)' after second CALWXT_POST me=',me +! write(*,*)' after second CALWXT_POST me=',me ! print *,'in SURFCE,me=',me,'IWX1=',IWX1(1:30,JSTA) ! DOMINANT PRECIPITATION TYPE @@ -4815,11 +4815,11 @@ SUBROUTINE SURFCE ! BOURGOUIN ALGORITHM ISEED=44641*(INT(SDAT(1)-1)*24*31+INT(SDAT(2))*24+IHRST)+ & & MOD(IFHR*60+IFMIN,44641)+4357 -! write(0,*)'in SURFCE,me=',me,'bef sec CALWXT_BOURG_POST' +! write(*,*)'in SURFCE,me=',me,'bef sec CALWXT_BOURG_POST' CALL CALWXT_BOURG_POST(IM,ISTA_2L,IEND_2U,ISTA,IEND,JM,JSTA_2L,JEND_2U,JSTA,JEND,LM,LP1,& & ISEED,G,PTHRESH, & & T,Q,PMID,PINT,LMH,AVGPREC,ZINT,IWX1,me) -! write(0,*)'in SURFCE,me=',me,'aft sec CALWXT_BOURG_POST' +! write(*,*)'in SURFCE,me=',me,'aft sec CALWXT_BOURG_POST' ! print *,'in SURFCE,me=',me,'IWX1=',IWX1(1:30,JSTA) ! DECOMPOSE IWX1 ARRAY @@ -4837,7 +4837,7 @@ SUBROUTINE SURFCE ! REVISED NCEP ALGORITHM CALL CALWXT_REVISED_POST(T,Q,PMID,PINT,HTM,LMH,AVGPREC,ZINT,IWX1) -! write(0,*)'in SURFCE,me=',me,'aft sec CALWXT_REVISED_BOURG_POST' +! write(*,*)'in SURFCE,me=',me,'aft sec CALWXT_REVISED_BOURG_POST' ! print *,'in SURFCE,me=',me,'IWX1=',IWX1(1:30,JSTA) ! DECOMPOSE IWX1 ARRAY ! @@ -4854,7 +4854,7 @@ SUBROUTINE SURFCE ! EXPLICIT ALGORITHM (UNDER 18 NOT ADMITTED WITHOUT PARENT OR GUARDIAN) -! write(0,*)'in SURFCE,me=',me,'imp_physics=',imp_physics +! write(*,*)'in SURFCE,me=',me,'imp_physics=',imp_physics IF(imp_physics == 5)then CALL CALWXT_EXPLICIT_POST(LMH,THS,PMID,AVGPREC,SR,F_RimeF,IWX1) else diff --git a/sorc/ncep_post.fd/TABLE.f b/sorc/ncep_post.fd/TABLE.f index 190b845aa..120a0e79f 100644 --- a/sorc/ncep_post.fd/TABLE.f +++ b/sorc/ncep_post.fd/TABLE.f @@ -101,7 +101,7 @@ SUBROUTINE TABLE(PTBL,TTBL,PT & enddo !--------------COARSE LOOK-UP TABLE FOR T(P) FROM CONSTANT THE---------- P = PL - DP -! write(0,*)' kpm=',kpm,' P=',P,' DP=',DP,' thl=',thl,' dth=',dth +! write(*,*)' kpm=',kpm,' P=',P,' DP=',DP,' thl=',thl,' dth=',dth DO KP=1,KPM P = P + DP TH = THL - DTH @@ -120,11 +120,11 @@ SUBROUTINE TABLE(PTBL,TTBL,PT & ENDIF ! QS=PQ0/P*EXP(A2*(TH-A3*APE)/(TH-A4*APE)) TOLD(KTH) = TH / APE -! write(0,*)' TH=',TH,' QS=',QS,' TOLD=',TOLD(kth),' kth=',kth +! write(*,*)' TH=',TH,' QS=',QS,' TOLD=',TOLD(kth),' kth=',kth THEOLD(KTH) = TH*EXP(ELIWV*QS/(CP*TOLD(KTH))) endif enddo -! write(0,*)' theold=',theold +! write(*,*)' theold=',theold ! THE0K = THEOLD(1) STHEK = THEOLD(KTHM) - THEOLD(1) diff --git a/sorc/ncep_post.fd/WRFPOST.f b/sorc/ncep_post.fd/WRFPOST.f index 05707b0a8..ccbc2c18b 100644 --- a/sorc/ncep_post.fd/WRFPOST.f +++ b/sorc/ncep_post.fd/WRFPOST.f @@ -219,7 +219,7 @@ PROGRAM WRFPOST ! 303 format('MODELNAME="',A,'" SUBMODELNAME="',A,'"') - write(0,*)'MODELNAME: ', MODELNAME, SUBMODELNAME + 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 @@ -692,14 +692,14 @@ PROGRAM WRFPOST ! -------- grib2 processing --------------- ! ------------------ ! elseif (grib == "grib2") then - if (me==0) write(0,*) ' in WRFPOST OUTFORM= ',grib - if (me==0) write(0,*) ' GRIB1 IS NOT SUPPORTED ANYMORE' + if (me==0) write(*,*) ' in WRFPOST OUTFORM= ',grib + if (me==0) write(*,*) ' GRIB1 IS NOT SUPPORTED ANYMORE' if (grib == "grib2") then do while (npset < num_pset) npset = npset+1 - if (me==0) write(0,*)' in WRFPOST npset=',npset,' num_pset=',num_pset + if (me==0) write(*,*)' in WRFPOST npset=',npset,' num_pset=',num_pset CALL SET_OUTFLDS(kth,th,kpv,pv) - if (me==0) write(0,*)' in WRFPOST size datapd',size(datapd) + if (me==0) write(*,*)' in WRFPOST size datapd',size(datapd) if(allocated(datapd)) deallocate(datapd) !Jesse x-decomposition ! allocate(datapd(im,1:jend-jsta+1,nrecout+100)) @@ -715,8 +715,8 @@ PROGRAM WRFPOST enddo enddo call get_postfilename(post_fname) - if (me==0) write(0,*)'post_fname=',trim(post_fname) - if (me==0) write(0,*)'get_postfilename,post_fname=',trim(post_fname), & + if (me==0) write(*,*)'post_fname=',trim(post_fname) + if (me==0) write(*,*)'get_postfilename,post_fname=',trim(post_fname), & 'npset=',npset, 'num_pset=',num_pset, & 'iSF_SURFACE_PHYSICS=',iSF_SURFACE_PHYSICS ! @@ -728,11 +728,11 @@ PROGRAM WRFPOST CALL PROCESS(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) IF(ME == 0) WRITE(6,*)'WRFPOST: PREPARE TO PROCESS NEXT GRID' ! -! write(0,*)'enter gribit2 before mpi_barrier' +! write(*,*)'enter gribit2 before mpi_barrier' call mpi_barrier(mpi_comm_comp,ierr) ! if(me==0)call w3tage('bf grb2 ') -! write(0,*)'enter gribit2 after mpi barrier' +! write(*,*)'enter gribit2 after mpi barrier' call gribit2(post_fname) deallocate(datapd) deallocate(fld_info) diff --git a/sorc/ncep_post.fd/grib2_module.f b/sorc/ncep_post.fd/grib2_module.f index dadeacb10..23ab33de4 100644 --- a/sorc/ncep_post.fd/grib2_module.f +++ b/sorc/ncep_post.fd/grib2_module.f @@ -1490,7 +1490,7 @@ subroutine g2getbits(MXBIT,ibm,scl,len,bmap,g,ibs,ids,nbits) ENDIF ENDIF -! write(0,*)' GMIN=',GMIN,' GMAX=',GMAX +! write(*,*)' GMIN=',GMIN,' GMAX=',GMAX ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! COMPUTE NUMBER OF BITS icnt = 0 @@ -1525,7 +1525,7 @@ subroutine g2getbits(MXBIT,ibm,scl,len,bmap,g,ibs,ids,nbits) rng2 = range * 2. ** (-ibs) nbits = INT ( ALOG ( rng2 ) / rln2 ) + 1 END IF -! write(0,*)'in g2getnits,ibs=',ibs,'ids=',ids,'nbits=',nbits,'range=',range +! write(*,*)'in g2getnits,ibs=',ibs,'ids=',ids,'nbits=',nbits,'range=',range !* IF(nbits <= 0) THEN nbits = 0 @@ -1538,7 +1538,7 @@ subroutine g2getbits(MXBIT,ibm,scl,len,bmap,g,ibs,ids,nbits) ENDIF ENDIF nbits = min(nbits,MXBIT) -! write(0,*)'in g2getnits ibs=',ibs,'ids=',ids,'nbits=',nbits +! write(*,*)'in g2getnits ibs=',ibs,'ids=',ids,'nbits=',nbits ! IF ( scl > 0.0 ) THEN s=10.0 ** ids @@ -1582,7 +1582,7 @@ subroutine g2getbits(MXBIT,ibm,scl,len,bmap,g,ibs,ids,nbits) endif ! endif -! write(0,*)'in g2getnits,2ibs=',ibs,'ids=',ids,'nbits=',nbits,'range=',& +! write(*,*)'in g2getnits,2ibs=',ibs,'ids=',ids,'nbits=',nbits,'range=',& ! range, 'scl=',scl,'data=',maxval(g),minval(g) ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - RETURN @@ -1826,7 +1826,7 @@ subroutine getgds(ldfgrd,len3,ifield3len,igds,ifield3) ENDIF -! write(0,*)'igds=',igds,'igdstempl=',ifield3(1:ifield3len) +! write(*,*)'igds=',igds,'igdstempl=',ifield3(1:ifield3len) end subroutine getgds ! !------------------------------------------------------------------------------------- diff --git a/sorc/ncep_post.fd/xml_perl_data.f b/sorc/ncep_post.fd/xml_perl_data.f index a17ac307b..5978b5208 100644 --- a/sorc/ncep_post.fd/xml_perl_data.f +++ b/sorc/ncep_post.fd/xml_perl_data.f @@ -108,10 +108,10 @@ subroutine read_postxconfig() ! Take the first line as paramset_count read(22,*)paramset_count - if(me==0)write(0,*)'xml_perl_data read Post flat file' + if(me==0)write(*,*)'xml_perl_data read Post flat file' ! Allocate paramset array size - if(me==0)write(0,*)'allocate paramset to :', paramset_count + if(me==0)write(*,*)'allocate paramset to :', paramset_count allocate(paramset(paramset_count)) @@ -123,14 +123,14 @@ subroutine read_postxconfig() do i = paramset_count, 1, -1 read(22,*)param_count - if(me==0)write(0,*)'allocate param to :', 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(0,*)'sum num_post_afld :', num_post_afld + if(me==0)write(*,*)'sum num_post_afld :', num_post_afld end do