Issue NOAA-EMC#2: fix runtime errors flagged by debug global_gsi.x - …

…committed changes do not alter analysis results
ClaraDraper-NOAA · Oct 13, 2020 · 1d3e30a · 1d3e30a
1 parent 5d40197
commit 1d3e30a
Show file tree

Hide file tree

Showing 5 changed files with 24 additions and 22 deletions.
diff --git a/src/gsi/dtast.f90 b/src/gsi/dtast.f90
@@ -65,7 +65,7 @@ subroutine dtast(work1,nlev,pbot,ptop,mesage,jiter,iout,pflag)
   ! First, print message and level information
 
   imsg=max(1,index(mesage,'$')-1)
-  ilin=max(imsg,min(nlev*9+34,240))
+  ilin=max(imsg,min(nlev*10+34,240))
   write(iout,'(a)') mesage(1:imsg)
   if (nlev > 1) then
      write(iout,800) '',  '',   '',   '',   '',    'ptop',(ptop(k),k=1,nlev)
@@ -206,16 +206,16 @@ subroutine dtast(work1,nlev,pbot,ptop,mesage,jiter,iout,pflag)
   endif ! if ( nlev == 1 )
 
 600  format(1x,'pressure levels (hPa)=',f6.1,1x,f6.1)
-700  format(1x,'o-g',1x,a2,  1x,a7,1x,a3,1x,a3,  1x,a4,  1x,a9, 1x,4(a9,  1x))
-701  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,i3.3,1x,i4.4,1x,i9,1x, 4(f9.4,1x))
-702  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,a3,  1x,a4,  1x,i9,1x, 4(f9.4,1x))
-800  format(1x,'o-g',1x,a2,  1x,a7,1x,a3,1x,a3,  1x,a4,  1x,a5,1x,12(f8.1,1x))
-801  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,i3.3,1x,i4.4,1x,a5,1x,12(i8,  1x))
-802  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,i3.3,1x,i4.4,1x,a5,1x,12(f8.2,1x))
-803  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,a3,  1x,a4,  1x,a5,1x,12(i8,  1x))
-804  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,a3,  1x,a4,  1x,a5,1x,12(f8.2,1x))
-901  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,i3.3,1x,i4.4,1x,i9,1x, 2(f12.4,1x),2(f9.4,1x))
-902  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,a3,  1x,a4,  1x,i9,1x, 2(f12.4,1x),2(f9.4,1x))
+700  format(1x,'o-g',1x,a2,  1x,a7,1x,a3,1x,a3,  1x,a4,  1x,a9,1x, 4(a9,  1x))
+701  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,i3.3,1x,i4.4,1x,i9,1x, 4(e9.3,1x))
+702  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,a3,  1x,a4,  1x,i9,1x, 4(e9.3,1x))
+800  format(1x,'o-g',1x,a2,  1x,a7,1x,a3,1x,a3,  1x,a4,  1x,a5,1x,12(e9.3,1x))
+801  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,i3.3,1x,i4.4,1x,a5,1x,12(i9,  1x))
+802  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,i3.3,1x,i4.4,1x,a5,1x,12(e9.3,1x))
+803  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,a3,  1x,a4,  1x,a5,1x,12(i9,  1x))
+804  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,a3,  1x,a4,  1x,a5,1x,12(e9.3,1x))
+901  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,i3.3,1x,i4.4,1x,i9,1x, 2(e9.3,1x),2(e9.3,1x))
+902  format(1x,'o-g',1x,i2.2,1x,a7,1x,a3,1x,a3,  1x,a4,  1x,i9,1x, 2(e9.3,1x),2(e9.3,1x))
 
   return
 end subroutine dtast
diff --git a/src/gsi/gesinfo.F90 b/src/gsi/gesinfo.F90
@@ -453,7 +453,7 @@ subroutine gesinfo
               ! FV3GFS write component does not write JCAP to the NEMSIO file
               if ( mype == mype_out ) then
                  write(6,*)'GESINFO:  ***WARNING*** guess jcap inconsistent with namelist'
-                 write(6,*)'GESINFO:  ***WARNING*** this is a FV3GFS NEMSIO file'
+                 write(6,*)'GESINFO:  ***WARNING*** this is a FV3GFS NEMSIO/NetCDF file'
               endif
               fatal = .false.
            else
@@ -481,7 +481,7 @@ subroutine gesinfo
         else
            write(6,200) gfshead%jcap,gfshead%levs,gfshead%latb,gfshead%lonb,&
                 gfshead%ntrac,gfshead%ncldt,idvc5,gfshead%nvcoord,idsl5
-200        format('GESINFO:  jcap_b=',i4,', levs=',i3,', latb=',i5,&
+200        format('GESINFO:  jcap_b=',i5,', levs=',i3,', latb=',i5,&
                 ', lonb=',i5,', ntrac=',i3,', ncldt=',i3,', idvc=',i3,&
                 ', nvcoord=',i3,', idsl=',i3)
         end if

diff --git a/src/gsi/mod_vtrans.f90 b/src/gsi/mod_vtrans.f90
@@ -243,8 +243,6 @@ subroutine create_vtrans(mype)
 
 !   get work pe:
 
-    print_verbose=.false.
-    if(verbose .and. g1%mype==workpe) print_verbose=.true.
     allocate(numlevs(0:g1%npe-1))
     numlevs(0:g1%npe-1)=g1%kend(0:g1%npe-1)-g1%kbegin(0:g1%npe-1)+1
     if(g1%mype==0) then
@@ -258,6 +256,10 @@ subroutine create_vtrans(mype)
     call mpi_bcast(workpe,1,mpi_integer,0,mpi_comm_world,ierror)
    !write(6,*)' mype,workpe=',mype,workpe
 
+    print_verbose=.false.
+    if(verbose .and. g1%mype==workpe) print_verbose=.true.
+
+
 !    obtain vertical coordinate constants ahat,bhat,chat
     if(mype==workpe) call getabc(ahat,bhat,chat)
 

diff --git a/src/gsi/read_abi.f90 b/src/gsi/read_abi.f90
@@ -323,6 +323,7 @@ subroutine read_abi(mype,val_abi,ithin,rmesh,jsatid,&
 
         nread=nread+nchanl
 
+        rcldfrc=bmiss
         if(clrsky) then 
            call ufbrep(lnbufr,dataabi1,1,ncld,iret,'NCLDMNT')
            rclrsky=bmiss
@@ -338,7 +339,9 @@ subroutine read_abi(mype,val_abi,ithin,rmesh,jsatid,&
            rclrsky=dataabi1(1,1)  !clear-sky percentage
 !          rclrsky=dataabi1(1,2)  !clear-sky percentage over sea
            call ufbrep(lnbufr,dataabi,1,4,iret,'CLDMNT')
-           rcldfrc=dataabi(1,1)   !total cloud 
+           if (dataabi(1,1)>= zero .and. dataabi(1,1) <= 100.0_r_kind ) then
+              rcldfrc=dataabi(1,1)   !total cloud 
+           end if
         end if
 
         call ufbrep(lnbufr,dataabi2,1,nbrst,iret,'TMBRST')

diff --git a/src/gsi/read_obs.F90 b/src/gsi/read_obs.F90
@@ -1840,12 +1840,9 @@ subroutine read_obs(ndata,mype)
                call warn('read_obs','                string =',trim(string))
              endif
 
-             write(6,8000) adjustl(string),infile,obstype,sis,nread,ithin,&
-                  rmesh,isfcalc,nouse,npe_sub(i)
-8000         format(1x,a22,': file=',a15,&
-                  ' type=',a10,  ' sis=',a20,  ' nread=',i10,&
-                  ' ithin=',i2, ' rmesh=',f11.6,' isfcalc=',i2,&
-                  ' nkeep=',i10,' ntask=',i3)
+             write(6, '(a,'': file='',a,'' type='',a,'' sis='',a,'' nread='',i10,&
+                  '' ithin='',i2,'' rmesh='',f11.6,'' isfcalc='',i2,'' nkeep='',i10,&
+                  '' ntask='',i3)')
 
           endif
        endif task_belongs