Skip to content

Commit

Permalink
fixed the UPP crash in Atmos (#525)
Browse files Browse the repository at this point in the history
* fixed the UPP crash in Atmos

* format changes in INITPOST_GFS_NEMS_MPIIO.f reading chemstry diagnostic vars
  • Loading branch information
lipan-NOAA committed Jun 23, 2022
1 parent 4b10df4 commit 8c39088
Showing 1 changed file with 110 additions and 67 deletions.
177 changes: 110 additions & 67 deletions sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f
Original file line number Diff line number Diff line change
Expand Up @@ -3673,8 +3673,45 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
CUPPT(i,j) = SPVAL
enddo
enddo
! done with flux file, close it for now
call nemsio_close(ffile,iret=status)
deallocate(tmp,recname,reclevtyp,reclev)
! Retrieve aer fields if it's listed (GOCART)
print *, 'iostatus for aer file=', iostatusAER
if(iostatusAER == 0) then ! start reading aer file
call nemsio_open(rfile,trim(fileNameAER),'read',mpi_comm_comp &
,iret=status)
if ( Status /= 0 ) then
print*,'error opening ',fileNameAER, ' Status = ', Status
endif
call nemsio_getfilehead(rfile,iret=status,nrec=nrec)
print*,'nrec for aer file=',nrec
allocate(recname(nrec),reclevtyp(nrec),reclev(nrec))
call nemsio_getfilehead(rfile,iret=iret,recname=recname &
,reclevtyp=reclevtyp,reclev=reclev)
if(debugprint)then
if (me == 0)then
do i=1,nrec
print *,'recname,reclevtyp,reclev=',trim(recname(i)),' ', &
trim(reclevtyp(i)),reclev(i)
end do
end if
end if
! start reading nemsio aer files using parallel read
fldsize=(jend-jsta+1)*im
allocate(tmp(fldsize*nrec))
print*,'allocate tmp successfully'
tmp=0.
call nemsio_denseread(rfile,1,im,jsta,jend,tmp,iret=iret)
if(iret/=0)then
print*,"fail to read aer file using mpi io read, stopping"
stop
end if

! retrieve dust emission fluxes
do K = 1, nbin_du
if ( K == 1) VarName='duem001'
Expand All @@ -3684,11 +3721,11 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 5) VarName='duem005'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,duem(1,jsta_2l,K))
! if(debugprint)print*,'sample ',VarName,' = ',duem(isa,jsa,k)
if(debugprint)print*,'sample ',VarName,' = ',duem(isa,jsa,k)
enddo

! retrieve dust sedimentation fluxes
Expand All @@ -3700,9 +3737,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 5) VarName='dust5sd'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,dusd(1,jsta_2l,K))
! if(debugprint)print*,'sample ',VarName,' = ',dusd(isa,jsa,k)
enddo
Expand All @@ -3716,10 +3753,10 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 5) VarName='dust5dp'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
,dudp(1,jsta_2l,K))
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,dudp(1,jsta_2l,K))
print *,'dudp,ck=',maxval(dudp(1:im,jsta:jend,k)), &
minval(dudp(1:im,jsta:jend,k))
! if(debugprint)print*,'sample ',VarName,' = ',dudp(isa,jsa,k)
Expand All @@ -3734,9 +3771,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 5) VarName='dust5wtl'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,duwt(1,jsta_2l,K))
enddo
! retrieve dust scavenging fluxes
Expand All @@ -3748,9 +3785,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 5) VarName='dust5wtc'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,dusv(1,jsta_2l,K))
enddo

Expand All @@ -3763,9 +3800,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 5) VarName='ssem005'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,ssem(1,jsta_2l,K))
enddo

Expand All @@ -3778,9 +3815,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 5) VarName='seas5sd'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,sssd(1,jsta_2l,K))
enddo

Expand All @@ -3793,9 +3830,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 5) VarName='seas5dp'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,ssdp(1,jsta_2l,K))
enddo

Expand All @@ -3808,9 +3845,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 5) VarName='seas5wtl'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,sswt(1,jsta_2l,K))
enddo

Expand All @@ -3823,9 +3860,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 5) VarName='seas1wtc'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,sssv(1,jsta_2l,K))
enddo

Expand All @@ -3835,9 +3872,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 2) VarName='bcembb'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,bcem(1,jsta_2l,K))
enddo

Expand All @@ -3847,9 +3884,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 2) VarName='bc2sd'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,bcsd(1,jsta_2l,K))
enddo

Expand All @@ -3859,9 +3896,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 2) VarName='bc2dp'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,bcdp(1,jsta_2l,K))
enddo

Expand All @@ -3871,9 +3908,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 2) VarName='bc2wtl'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,bcwt(1,jsta_2l,K))
enddo

Expand All @@ -3883,9 +3920,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 2) VarName='bc2wtc'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,bcsv(1,jsta_2l,K))
enddo

Expand All @@ -3895,9 +3932,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 2) VarName='ocembb'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,ocem(1,jsta_2l,K))
enddo

Expand All @@ -3907,9 +3944,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 2) VarName='oc2sd'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,ocsd(1,jsta_2l,K))
enddo

Expand All @@ -3919,9 +3956,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 2) VarName='oc2dp'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,ocdp(1,jsta_2l,K))
enddo

Expand All @@ -3931,9 +3968,9 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 2) VarName='oc2wtl'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,ocwt(1,jsta_2l,K))
enddo

Expand All @@ -3943,24 +3980,24 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
if ( K == 2) VarName='oc2wtc'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,ocsv(1,jsta_2l,K))
enddo
! retrieve MIE AOD
VarName='maod'
VcoordName='sfc'
l=1
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName&
call assignnemsiovar(im,jsta,jend,jsta_2l,jend_2u &
,l,nrec,fldsize,spval,tmp &
,recname,reclevtyp,reclev,VarName,VcoordName &
,maod(1,jsta_2l))


! done with flux file, close it for now
call nemsio_close(ffile,iret=status)
deallocate(tmp,recname,reclevtyp,reclev)
! call nemsio_close(ffile,iret=status)
! deallocate(tmp,recname,reclevtyp,reclev)

!lzhang
!! retrieve sfc mass concentration
Expand Down Expand Up @@ -4005,6 +4042,12 @@ SUBROUTINE INITPOST_GFS_NEMS_MPIIO(iostatusAER)
! ,recname,reclevtyp,reclev,VarName,VcoordName &
! ,ducmass25)
! if(debugprint)print*,'sample ',VarName,' = ',ducmass25(isa,jsa)

if (me == 0) print *,'after aer files reading,mype=',me
call nemsio_close(rfile,iret=status)
deallocate(tmp,recname,reclevtyp,reclev)
end if ! end of aer file read

! pos east
call collect_loc(gdlat,dummy)
if(me == 0)then
Expand Down

0 comments on commit 8c39088

Please sign in to comment.