From 8c390887273a6c5d50a8e114f706496811553fc6 Mon Sep 17 00:00:00 2001 From: lipan-NOAA Date: Thu, 23 Jun 2022 09:51:09 -0400 Subject: [PATCH] fixed the UPP crash in Atmos (#525) * fixed the UPP crash in Atmos * format changes in INITPOST_GFS_NEMS_MPIIO.f reading chemstry diagnostic vars --- sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f | 177 ++++++++++++-------- 1 file changed, 110 insertions(+), 67 deletions(-) diff --git a/sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f b/sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f index 22fc118ac..2819c4e5f 100644 --- a/sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f +++ b/sorc/ncep_post.fd/INITPOST_GFS_NEMS_MPIIO.f @@ -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' @@ -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 @@ -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 @@ -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) @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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