From 481bdab2d2b0493f197e2209590b00fcbac29696 Mon Sep 17 00:00:00 2001 From: "jun.wang@noaa.gov" Date: Thu, 14 Sep 2017 19:32:09 +0000 Subject: [PATCH] TRUNK COMMIT, ticket 28: output Gaussian grid nemsio files through write grid component M module_fcst_grid_comp.F90 M atmos_cubed_sphere/tools/fv_nggps_diag.F90 M atmos_model.F90 M io/module_wrt_grid_comp.F90 M io/FV3GFS_io.F90 M io/module_fv3_io_def.F90 A + io/module_write_nemsio.F90 M io/makefile M makefile M fv3_cap.F90 --- atmos_cubed_sphere/tools/fv_nggps_diag.F90 | 36 +- atmos_model.F90 | 2 +- fv3_cap.F90 | 41 +- io/FV3GFS_io.F90 | 18 +- io/makefile | 3 + io/module_fv3_io_def.F90 | 2 +- io/module_write_nemsio.F90 | 498 +++++++++++++++++++++ io/module_wrt_grid_comp.F90 | 424 +++++++++++------- makefile | 2 +- module_fcst_grid_comp.F90 | 7 +- 10 files changed, 858 insertions(+), 175 deletions(-) create mode 100644 io/module_write_nemsio.F90 diff --git a/atmos_cubed_sphere/tools/fv_nggps_diag.F90 b/atmos_cubed_sphere/tools/fv_nggps_diag.F90 index 1b603de78..5d607e444 100644 --- a/atmos_cubed_sphere/tools/fv_nggps_diag.F90 +++ b/atmos_cubed_sphere/tools/fv_nggps_diag.F90 @@ -379,7 +379,7 @@ subroutine fv_dyn_bundle_setup(axes, dyn_bundle, fcst_grid, quilting ) integer num_axes, id, axis_length, direction, edges integer num_attributes, num_field_dyn, axis_typ character(255) :: units, long_name, cart_name,axis_direct,edgesS - character(128) :: output_name + character(128) :: output_name, shydrostatic integer currdate(6) type(domain1d) :: Domain real,dimension(:),allocatable :: axis_data @@ -407,8 +407,40 @@ subroutine fv_dyn_bundle_setup(axes, dyn_bundle, fcst_grid, quilting ) num_axes = size(axes) allocate(all_axes(num_axes)) all_axes(1:num_axes) = axes(1:num_axes) +! print *,'in fv_dyn bundle,num_axes=',num_axes ! if(mpp_pe()==mpp_root_pe())print *,'in fv_dyn bundle,num_axes=',num_axes, 'axes=',axes - +! +!*** add global attributes in the field bundle: + call ESMF_AttributeAdd(dyn_bundle, convention="NetCDF", purpose="FV3", & + attrList=(/"hydrostatic"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (hydrostatico ) then + shydrostatic = 'hydrostatic' + else + shydrostatic = 'non-hydrostatic' + endif + call ESMF_AttributeSet(dyn_bundle, convention="NetCDF", purpose="FV3", & + name="hydrostatic", value=trim(shydrostatic), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! + call ESMF_AttributeAdd(dyn_bundle, convention="NetCDF", purpose="FV3", & + attrList=(/"ncnsto"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_AttributeSet(dyn_bundle, convention="NetCDF", purpose="FV3", & + name="ncnsto", value=ncnsto, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! !*** get axis names allocate(axis_name(num_axes)) diff --git a/atmos_model.F90 b/atmos_model.F90 index 461c81a7d..4d13eecc3 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -425,7 +425,7 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step) !--- update tracers in FV3 with any initialized during the physics/radiation init phase !rab call atmosphere_tracer_postinit (IPD_Data, Atm_block) - call gfdl_diag_register (Time, IPD_Data(:)%Sfcprop, IPD_Data(:)%IntDiag, Atm_block, Atmos%axes, IPD_Control%nfxr) + call gfdl_diag_register (Time, IPD_Data(:)%Sfcprop, IPD_Data(:)%IntDiag, Atm_block, IPD_Control, Atmos%axes, IPD_Control%nfxr) call FV3GFS_restart_read (IPD_Data, IPD_Restart, Atm_block, IPD_Control, Atmos%domain) !--- set the initial diagnostic timestamp diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 83699a150..db23a0e4d 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -28,7 +28,8 @@ module fv3gfs_cap_mod num_files, filename_base, & wrttasks_per_group, n_group, & lead_wrttask, last_wrttask, & - write_netcdfflag, output_grid, imo,jmo + write_nemsiofile, output_grid, & + imo, jmo ! use module_fcst_grid_comp, only: fcstSS => SetServices use module_wrt_grid_comp, only: wrtSS => SetServices @@ -181,11 +182,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=*),parameter :: subname='(mom_cap:InitializeAdvertise)' integer nfmout, nfsout , nfmout_hf, nfsout_hf - real(kind=8) :: MPI_Wtime, timefs + real(kind=8) :: MPI_Wtime, timewri, timeis,timeie,timerhs, timerhe ! !------------------------------------------------------------------------ ! rc = ESMF_SUCCESS + timeis = mpi_wtime() call ESMF_GridCompGet(gcomp,name=name,vm=vm,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -199,7 +201,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) line=__LINE__, & file=__FILE__)) & return ! bail out -! print *,'in fv3_cap,initAdvertize,name=',trim(name),'petlist=',petlist,'rc=',rc +! print *,'in fv3_cap,initAdvertize,name=',trim(name),'mpi_comm=',mpi_comm_atm, & +! 'petcount=',petcount,'mype=',mype clock_fv3=clock ! @@ -279,9 +282,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_ConfigGetAttribute(config=CF,value=nfhout_hf,label ='nfhout_hf:',rc=rc) call ESMF_ConfigGetAttribute(config=CF,value=nsout, label ='nsout:',rc=rc) call ESMF_ConfigGetAttribute(config=CF,value=output_grid, label ='output_grid:',rc=rc) - if(trim(output_grid) == 'gaussian grid') then + if(mype==0) print *,'af nems config,output_grid=',trim(output_grid) + write_nemsiofile=.false. + if(trim(output_grid) == 'gaussian_grid') then call ESMF_ConfigGetAttribute(config=CF,value=imo, label ='imo:',rc=rc) call ESMF_ConfigGetAttribute(config=CF,value=jmo, label ='jmo:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF,value=write_nemsiofile, label ='write_nemsiofile:',rc=rc) + if(mype==0) print *,'af nems config,imo=',imo,'jmo=',jmo,'write_nemsiofile=', write_nemsiofile endif if(mype==0) print *,'af nems config,dt_atmos=',dt_atmos,'nfhmax=',nfhmax, & 'nfhout=',nfhout,nfhmax_hf,nfhout_hf, nsout @@ -455,6 +462,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if(mype==0) print *,'af allco wrtComp,write_groups=',write_groups ! k = num_pes_fcst + timerhs = mpi_wtime() do i=1, write_groups ! prepare petList for wrtComp(i) @@ -577,9 +585,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite('bf FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) + timewri = mpi_wtime() call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,i), & regridMethod=regridmethod, routehandle=routehandle(j,i), rc=rc) +! print *,'after regrid store, group i=',i,' fb=',j,' time=',mpi_wtime()-timewri + call ESMF_LogWrite('af FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -590,6 +601,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! end write_groups enddo +! print *,'in fv3cap init, time wrtcrt/regrdst',mpi_wtime()-timerhs deallocate(petList) ! !--------------------------------------------------------------------------------- @@ -658,6 +670,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !end quilting endif ! +! print *,'in fv3_cap, init time=',mpi_wtime()-timeis !----------------------------------------------------------------------- ! end subroutine InitializeAdvertise @@ -711,7 +724,6 @@ subroutine ModelAdvance(gcomp, rc) !----------------------------------------------------------------------------- - timewri = mpi_wtime() rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering FV3 Model_ADVANCE: ") ! @@ -782,6 +794,7 @@ subroutine ModelAdvance(gcomp, rc) ! !*** for forecast tasks + timewri = mpi_wtime() call ESMF_LogWrite('Model Advance: before fcstcomp run ', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -846,21 +859,23 @@ subroutine ModelAdvance(gcomp, rc) output: IF(lalarm .or. na==1 ) then + timerhi = mpi_wtime() do i=1, FBCount ! ! get fcst fieldbundle ! call ESMF_FieldBundleRegrid(fcstFB(i), wrtFB(i,n_group), & routehandle=routehandle(i, n_group), rc=rc) + timerh = mpi_wtime() if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) -! if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'aft fieldbundleregrid, rc=',rc, & -! 'na=',na ! !end FBcount enddo + if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'aft fieldbundleregrid,na=',na, & + ' time=', timerh- timerhi ! if(mype==0 .or. mype==lead_wrttask(1)) print *,'on wrt bf wrt run, na=',na call ESMF_LogWrite('Model Advance: before wrtcomp run ', ESMF_LOGMSG_INFO, rc=rc) @@ -869,7 +884,9 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) + timerhi = mpi_wtime() call ESMF_GridCompRun(wrtComp(n_group), importState=wrtState(n_group), clock=clock_fv3,userRc=urc,rc=rc) + timerh = mpi_wtime() if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -878,6 +895,8 @@ subroutine ModelAdvance(gcomp, rc) line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'aft wrtgridcomp run,na=',na, & + ' time=', timerh- timerhi call ESMF_LogWrite('Model Advance: after wrtcomp run ', ESMF_LOGMSG_INFO, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -885,6 +904,10 @@ subroutine ModelAdvance(gcomp, rc) file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) + if (mype == 0 .or. mype == lead_wrttask(n_group)) print *,'fv3_cap,aft model advance,na=', & + na,' time=', mpi_wtime()- timewri + + if(n_group == write_groups) then n_group = 1 else @@ -896,6 +919,10 @@ subroutine ModelAdvance(gcomp, rc) ! end quilting endif +! if (mype == 0 .or. mype == 1536 .or. mype==2160) then +! print *,'fv3_cap,end integrate,na=',na,' time=',mpi_wtime()- timewri +! endif + !*** end integreate loop enddo integrate diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index d42cdfd65..583a72254 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -92,6 +92,7 @@ module FV3GFS_io_mod integer :: tot_diag_idx = 0 integer :: total_outputlevel = 0 integer :: isco,ieco,jsco,jeco + integer :: fhzero integer,dimension(:), allocatable :: nstt real(4), dimension(:,:,:), allocatable, target :: buffer_phys integer, parameter :: DIAG_SIZE = 250 @@ -1166,13 +1167,14 @@ end subroutine phys_restart_write ! 13+NFXR - radiation ! 76+pl_coeff - physics !------------------------------------------------------------------------- - subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Atm_block, axes, NFXR) + subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Atm_block, Model, axes, NFXR) use physcons, only: con_g !--- subroutine interface variable definitions type(time_type), intent(in) :: Time type(Gfs_sfcprop_type), intent(in) :: Sfcprop(:) type(GFS_diag_type), intent(in) :: Gfs_diag(:) type (block_control_type), intent(in) :: Atm_block + type(IPD_control_type), intent(in) :: Model integer, dimension(4), intent(in) :: axes integer, intent(in) :: NFXR !--- local variables @@ -1192,6 +1194,7 @@ subroutine gfdl_diag_register(Time, Sfcprop, Gfs_diag, Atm_block, axes, NFXR) ieco = Atm_block%iec jsco = Atm_block%jsc jeco = Atm_block%jec + fhzero = nint(Model%fhzero) Diag(:)%id = -99 Diag(:)%axes = -99 @@ -3036,6 +3039,19 @@ subroutine fv_phys_bundle_setup(axes, phys_bundle, fcst_grid, quilting ) !*** add attributes to the bundle such as subdomain limtis, !*** axes, output time, etc !------------------------------------------------------------ +! + call ESMF_AttributeAdd(phys_bundle, convention="NetCDF", purpose="FV3", & + attrList=(/"fhzero"/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_AttributeSet(phys_bundle, convention="NetCDF", purpose="FV3", & + name="fhzero", value=fhzero, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! !*** add attributes (for phys, set axes to 2) num_axes = 2 diff --git a/io/makefile b/io/makefile index ef7494e0d..68c1d3738 100644 --- a/io/makefile +++ b/io/makefile @@ -28,6 +28,7 @@ SRCS_F = SRCS_F90 = \ ./FV3GFS_io.F90 \ + ./module_write_nemsio.F90 \ ./module_fv3_io_def.F90 \ ./module_write_internal_state.F90 \ ./module_wrt_grid_comp.F90 @@ -51,6 +52,8 @@ $(LIBRARY): $(OBJS) FV3GFS_io.o: FV3GFS_io.F90 $(FC) $(CPPDEFS) $(CPPFLAGS) $(FPPFLAGS) $(FFLAGS) $(OTHERFLAGS) $(OTHER_FFLAGS) $(ESMF_INC) -c FV3GFS_io.F90 +module_write_nemsio.o: module_write_nemsio.F90 + $(FC) $(CPPDEFS) $(CPPFLAGS) $(FPPFLAGS) $(FFLAGS) $(OTHERFLAGS) $(OTHER_FFLAGS) $(ESMF_INC) $(NEMSIOINC) -c module_write_nemsio.F90 module_write_internal_state.o: module_write_internal_state.F90 $(FC) $(CPPDEFS) $(CPPFLAGS) $(FPPFLAGS) $(FFLAGS) $(OTHERFLAGS) $(OTHER_FFLAGS) $(ESMF_INC) -c module_write_internal_state.F90 module_wrt_grid_comp.o: module_wrt_grid_comp.F90 diff --git a/io/module_fv3_io_def.F90 b/io/module_fv3_io_def.F90 index 10de838b5..7913213bb 100644 --- a/io/module_fv3_io_def.F90 +++ b/io/module_fv3_io_def.F90 @@ -12,7 +12,7 @@ module module_fv3_io_def integer :: num_pes_fcst integer :: wrttasks_per_group, write_groups integer :: n_group - logical :: write_netcdfflag + logical :: write_nemsiofile integer :: num_files character(255) :: output_grid integer :: imo,jmo diff --git a/io/module_write_nemsio.F90 b/io/module_write_nemsio.F90 new file mode 100644 index 000000000..ca117fc1c --- /dev/null +++ b/io/module_write_nemsio.F90 @@ -0,0 +1,498 @@ +module module_write_nemsio + + use esmf + use nemsio_module + + implicit none + + include 'mpif.h' + + private + logical :: first_nemsio_call + integer :: im,jm,lm, idate(7),nmeta, nsoil,ncld, idrt, ntrac + integer :: mp_physi, CU_PHYSICS + integer :: mype, ntasks, mpi_comm, nbdl + logical :: hydrostatic + integer,dimension(200,100) :: nfldlev + character(16),dimension(3000,5) :: recname,reclevtyp + integer,dimension(3000,5) :: reclev + + integer,dimension(:), allocatable :: nrec + integer,dimension(:), allocatable :: fieldcount + integer, dimension(:), allocatable :: idisp, irecv +! + integer,dimension(:), allocatable :: nmetavari,nmetavarc, nmetavarr4,nmetavarr8 + integer,dimension(:), allocatable :: nmetaaryi,nmetaaryc, nmetaaryr4,nmetaaryr8 + character(16),dimension(:,:),allocatable :: variname, varcname, varr4name, varr8name + integer, dimension(:,:), allocatable :: varival + real(4), dimension(:,:), allocatable :: varr4val + real(8), dimension(:,:), allocatable :: varr8val + character(16), dimension(:,:), allocatable :: varcval + logical, dimension(:), allocatable :: extrameta + + public nemsio_first_call, write_nemsio + + contains + + subroutine nemsio_first_call(fieldbundle, imo, jmo, & + wrt_mype, wrt_ntasks, wrt_mpi_comm, wrt_nbdl, mybdl, inidate, rc) + type(ESMF_FieldBundle), intent(in) :: fieldbundle + integer, intent(in) :: imo, jmo + integer, intent(in) :: wrt_mype, wrt_ntasks, wrt_mpi_comm + integer, intent(in) :: wrt_nbdl, mybdl + integer, intent(in) :: inidate(7) + integer, optional,intent(out) :: rc + +!** local vars + integer i,j, nfld + integer fieldDimCount,gridDimCount + character(100) :: fieldname + type(ESMF_GRID) :: wrtgrid + type(ESMF_TypeKind_Flag) :: typekind + + integer, dimension(:), allocatable :: ungriddedLBound, ungriddedUBound + type(ESMF_Field), allocatable :: fcstField(:) + +!------------------------------------------------------------------- +! + im = imo + jm = jmo + nmeta = 5 + idrt = 4 + nsoil = 4 + ntrac = 3 + ncld = 1 + idate(1:7) = inidate(1:7) + mype = wrt_mype + ntasks= wrt_ntasks + nbdl = wrt_nbdl + mpi_comm = wrt_mpi_comm + if(.not.allocated(idisp)) allocate(idisp(ntasks),irecv(ntasks)) + if(.not.allocated(fieldCount)) allocate(fieldCount(nbdl)) + if(.not.allocated(nrec)) allocate(nrec(nbdl)) +! +!** get attibute info from fieldbundle + call get_global_attr(fieldbundle, mybdl, rc=rc) + +!** get meta info from fieldbundle + call ESMF_FieldBundleGet(fieldbundle, fieldCount=fieldCount(mybdl), & + grid=wrtGrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! + call ESMF_GridGet(wrtgrid, dimCount=gridDimCount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! + allocate(fcstField(fieldCount(mybdl))) + call ESMF_FieldBundleGet(fieldbundle, fieldList=fcstField, & + itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + nrec(mybdl)=0 + lm=1 + do i=1,fieldcount(mybdl) + + call ESMF_FieldGet(fcstField(i), typekind=typekind, & + dimCount=fieldDimCount, grid=wrtGrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + if (fieldDimCount > gridDimCount) then + allocate(ungriddedLBound(fieldDimCount-gridDimCount)) + allocate(ungriddedUBound(fieldDimCount-gridDimCount)) + call ESMF_FieldGet(fcstField(i), ungriddedLBound=ungriddedLBound, & + ungriddedUBound=ungriddedUBound, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + nfldlev(i,mybdl) = ungriddedUBound(fieldDimCount-gridDimCount) - & + ungriddedLBound(fieldDimCount-gridDimCount) + 1 + nrec(mybdl) = nrec(mybdl) + nfldlev(i,mybdl) + lm = nfldlev(i,mybdl) + deallocate(ungriddedLBound) + deallocate(ungriddedUBound) + else if(fieldDimCount == 2) then + nfldlev(i,mybdl) = 1 + nrec(mybdl) = nrec(mybdl) + 1 + endif + + enddo +! + nfld = 1 + do i=1,fieldcount(mybdl) + call ESMF_FieldGet(fcstField(i),name=fieldName,rc=rc) + if( nfldlev(i,mybdl) == 1) then + recname(nfld,mybdl) = trim(fieldName) + reclevtyp(nfld,mybdl) = "sfc" + reclev(nfld,mybdl) = 1 + nfld = nfld + 1 + else + do j = 1,nfldlev(i,mybdl) + recname(nfld,mybdl) = trim(fieldName) + reclevtyp(nfld,mybdl) = "isobaric_sfc" + reclev(nfld,mybdl) = j + nfld = nfld + 1 + enddo + endif + enddo +! + + end subroutine nemsio_first_call + +!---------------------------------------------------------------------------------------- + subroutine write_nemsio(fieldbundle, filename, nf_hours, & + nf_minutes, nf_seconds, mybdl, rc) +! + type(ESMF_FieldBundle), intent(in) :: fieldbundle + character(*), intent(in) :: filename + integer, intent(in) :: nf_hours, nf_minutes, nf_seconds + integer, intent(in) :: mybdl + integer, optional,intent(out) :: rc +! +!** local vars + integer i,j,m,n,k, jrec + integer istart, iend, jstart, jend, kstart, kend, nlen + real(4),dimension(:),allocatable :: tmp + real(4),dimension(:,:),allocatable :: arrayr4 + real(4),dimension(:,:),pointer :: arrayr42d + real(8),dimension(:,:),pointer :: arrayr82d + real(4),dimension(:,:,:),pointer :: arrayr43d + real(8),dimension(:,:,:),pointer :: arrayr83d + type(ESMF_Field), allocatable :: fcstField(:) + type(ESMF_TypeKind_Flag) :: typekind + type(nemsio_gfile) :: nemsiofile +! + +!** init nemsio + call nemsio_init(iret=rc) +! +!** OPEN NEMSIO FILE +! +! print *,'in write_nemsio,bf nemsio_open, filename=',trim(filename), & +! 'idate=',idate,'nfour=',NF_HOURS,NF_MINUTES,NF_SECONDS, 'mybdl=',mybdl,& +! 'dim=',im,jm,lm,'nmeta=',nmeta,'idrt=',idrt,'nsoil=',nsoil, & +! 'ntrac=',ntrac,'nrec=',nrec(mybdl),'extrameta=',extrameta(mybdl), & +! 'nmetavari=',nmetavari(mybdl),'nmetavarc=',nmetavarc(mybdl) +! if(nmetavari(mybdl)>0) print *,'in write_nemsio,bf nemsio_open,nmetavari=', & +! nmetavari(mybdl),'varival=',trim(variname(1,mybdl)),varival(1,mybdl) +! if(nmetavarc(mybdl)>0) print *,'in write_nemsio,bf nemsio_open,nmetavarc=', & +! nmetavarc(mybdl),'varcval=',trim(varcname(1,mybdl)),varcval(1,mybdl) + + if(mype==0) then + call nemsio_open(nemsiofile,trim(FILENAME),'write',rc, & + modelname="FV3", gdatatype="bin4", & + idate=idate,nfhour=NF_HOURS, nfminute=NF_MINUTES, & + nfsecondn=NF_SECONDS*100, nfsecondd=100, & + dimx=im,dimy=jm,dimz=lm, nmeta=nmeta,idrt=idrt, & + nsoil=nsoil,ntrac=ntrac,nrec=nrec(mybdl), ncldt=ncld, & + extrameta=extrameta(mybdl),recname=RECNAME(1:nrec(mybdl),mybdl), & + reclevtyp=RECLEVTYP(1:nrec(mybdl),mybdl), & + reclev=RECLEV(1:nrec(mybdl),mybdl), & + nmetavari=nmetavari(mybdl), nmetavarc=nmetavarc(mybdl), & + variname=variname(1:nmetavari(mybdl),mybdl), & + varival=varival(1:nmetavari(mybdl),mybdl), & + varcname=varcname(1:nmetavarc(mybdl),mybdl), & + varcval=varcval(1:nmetavarc(mybdl),mybdl) ) + if(rc/=0) print *,'nemsio_open, file=',trim(filename),' iret=',rc + endif +! +!** collect data to first pe and write out data +! + allocate(arrayr4(im,jm),tmp(im*jm)) + allocate(fcstField(fieldCount(mybdl))) + call ESMF_FieldBundleGet(fieldbundle, fieldList=fcstField, & + itemorderflag=ESMF_ITEMORDER_ADDORDER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) & return ! bail out + + jrec = 1 + do i=1, fieldcount(mybdl) +! + call ESMF_FieldGet(fcstField(i),typekind=typekind, rc=rc) + + if( nfldlev(i,mybdl) == 1) then + if( typekind == ESMF_TYPEKIND_R4) then + call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=arrayr42d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + istart = lbound(arrayr42d,1) + iend = ubound(arrayr42d,1) + jstart = lbound(arrayr42d,2) + jend = ubound(arrayr42d,2) + nlen = (iend-istart+1) * (jend-jstart+1) + elseif( typekind == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=arrayr82d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + istart = lbound(arrayr82d,1) + iend = ubound(arrayr82d,1) + jstart = lbound(arrayr82d,2) + jend = ubound(arrayr82d,2) + nlen = (iend-istart+1) * (jend-jstart+1) + allocate( arrayr42d(istart:iend,jstart:jend)) + do n=jstart,jend + do m=istart,iend + arrayr42d(m,n) = arrayr82d(m,n) + enddo + enddo + endif +! send data to task 0 + call mpi_gather(nlen, 1, MPI_INTEGER, irecv(:), 1, MPI_INTEGER, 0, mpi_comm, rc) + if(mype == 0) then + idisp(1) = 0 + do n=1,ntasks-1 + idisp(n+1) = idisp(n) + irecv(n) + enddo +! if(mype==0) print *,' collect data, idisp=',idisp(:) +! if(mype==0) print *,' collect data, irecv=',irecv(:) + endif +! if( trim(recname(jrec,mybdl))=="HGTsfc" .and. trim(recname(jrec,mybdl))=="sfc") then +! print *,'in write nemsio,fb=',i,' write jrec=',jrec,' val=',maxval(arrayr42d(istart:iend,jstart:jend)), & +! minval(arrayr42d(istart:iend,jstart:jend)),maxloc(arrayr42d(istart:iend,jstart:jend)), & +! minloc(arrayr42d(istart:iend,jstart:jend)) +! endif + call mpi_gatherv(arrayr42d,nlen,MPI_REAL, arrayr4,irecv,idisp(:), MPI_REAL, & + 0, mpi_comm, rc) + if(mype==0) then +! print *,'in write nemsio, value=',maxval(arrayr4(1:im,1:jm)), & +! minval(arrayr4(1:im,1:jm)),maxloc(arrayr4(1:im,1:jm)),minloc(arrayr4(1:im,1:jm)) + tmp = reshape(arrayr4, (/im*jm/)) + call nemsio_writerec(nemsiofile, jrec, tmp, iret=rc) +! print *,'in write nemsio,fb=',i,' write jrec=',jrec,'fld is', & +! trim(recname(jrec,mybdl)), 'rc=', & +! rc, 'value=',maxval(tmp),minval(tmp),maxloc(tmp),minloc(tmp) + endif + jrec = jrec + 1 + + elseif (nfldlev(i,mybdl) > 1) then + + if( typekind == ESMF_TYPEKIND_R4) then + call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=arrayr43d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + istart = lbound(arrayr43d,1) + iend = ubound(arrayr43d,1) + jstart = lbound(arrayr43d,2) + jend = ubound(arrayr43d,2) + kstart = lbound(arrayr43d,3) + kend = ubound(arrayr43d,3) + nlen = (iend-istart+1) * (jend-jstart+1) + lm = kend - kstart + 1 + elseif( typekind == ESMF_TYPEKIND_R8) then + call ESMF_FieldGet(fcstField(i), localDe=0, farrayPtr=arrayr83d, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + istart = lbound(arrayr83d,1) + iend = ubound(arrayr83d,1) + jstart = lbound(arrayr83d,2) + jend = ubound(arrayr83d,2) + kstart = lbound(arrayr43d,3) + kend = ubound(arrayr43d,3) + nlen = (iend-istart+1) * (jend-jstart+1) + lm = kend - kstart + 1 + endif + + ! send data to task 0 + call mpi_gather(nlen, 1, MPI_INTEGER, irecv, 1, MPI_INTEGER, 0, mpi_comm, rc) + if(mype == 0) then + idisp(1) = 0 + do n=1,ntasks-1 + idisp(n+1) = idisp(n) + irecv(n) + enddo + endif +! write out all levels + allocate(arrayr42d(istart:iend,jstart:jend)) + do k=kstart,kend + if (typekind == ESMF_TYPEKIND_R4) then + do n=jstart,jend + do m=istart,iend + arrayr42d(m,n)=arrayr43d(m,n,k) + enddo + enddo + elseif (typekind == ESMF_TYPEKIND_R8) then + do n=jstart,jend + do m=istart,iend + arrayr42d(m,n)=arrayr83d(m,n,k) + enddo + enddo + endif +! + call mpi_gatherv(arrayr42d, nlen, MPI_REAL, arrayr4, irecv,idisp, MPI_REAL, & + 0, mpi_comm, rc) + if(mype==0) then + tmp = reshape(arrayr4, (/im*jm/)) + call nemsio_writerec(nemsiofile, jrec, tmp, iret=rc) + jrec = jrec + 1 + endif + enddo + deallocate(arrayr42d) +! + endif + enddo +! + deallocate(tmp) + deallocate(arrayr4) + deallocate(fcstField) +! +!** close nemsio file + call nemsio_close(nemsiofile, iret=rc) +! + call nemsio_finalize() + + end subroutine write_nemsio + +!---------------------------------------------------------------------------------------- + + subroutine write_nemaio_final() + +!** + deallocate(irecv) + deallocate(idisp) + deallocate(fieldcount) + + end subroutine write_nemaio_final +! +!---------------------------------------------------------------------------------------- + + subroutine get_global_attr(fldbundle, mybdl, rc) + type(ESMF_FieldBundle), intent(in) :: fldbundle + integer, intent(in) :: mybdl + integer, intent(out) :: rc + +! local variable + integer i,j, k,n, attcount + integer ni,nr4,nr8, nc + character(80) attName, hydrostatics, fldname + type(ESMF_TypeKind_Flag) :: typekind +! +! look at the field bundle attributes + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, Count=attcount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +! first loop over all the attributes to find the count for integer attr, real +! attr, etc + j=1 + k=1 + if (.not. allocated(nmetavari)) then + allocate(nmetavari(nbdl),nmetavarr4(nbdl),nmetavarr8(nbdl),nmetavarc(nbdl)) + allocate(nmetaaryi(nbdl),nmetaaryr4(nbdl),nmetaaryr8(nbdl),nmetaaryc(nbdl)) + allocate(extrameta(nbdl)) + endif + nmetavari(mybdl)=0; nmetavarr4(mybdl)=0; nmetavarr8(mybdl)=0; nmetavarc(mybdl)=0 + nmetaaryi(mybdl)=0; nmetaaryr4(mybdl)=0; nmetaaryr8(mybdl)=0; nmetaaryc(mybdl)=0 + do i=1, attCount + + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i,name=attName, typekind=typekind, & + itemCount=n, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + +! add this attribute to the list of transfers + if (typekind==ESMF_TYPEKIND_CHARACTER) then + if( n == 1) then + nmetavarc(mybdl) = nmetavarc(mybdl) + 1 + else if (n > 1) then + nmetaaryc(mybdl) = nmetaaryc(mybdl) + 1 + endif + else if (typekind==ESMF_TYPEKIND_I4) then + if( n == 1) then + nmetavari(mybdl) = nmetavari(mybdl) + 1 + else if (n > 1) then + nmetaaryi(mybdl) = nmetaaryi(mybdl) + 1 + endif + else if (typekind==ESMF_TYPEKIND_R4) then + if( n == 1) then + nmetavarr4(mybdl) = nmetavarr4(mybdl) + 1 + else if (n > 1) then + nmetaaryr4(mybdl) = nmetaaryr4(mybdl) + 1 + endif + else if (typekind==ESMF_TYPEKIND_R8) then + if( n == 1) then + nmetavarr8(mybdl) = nmetavarr8(mybdl) + 1 + else if (n > 1) then + nmetaaryr8(mybdl) = nmetaaryr8(mybdl) + 1 + endif + endif + enddo +! print *,'in get _global_attr, nmetavarc=',nmetavarc(mybdl),'nmetaaryc=',nmetaaryc(mybdl), & +! 'nmetavari=',nmetavari(mybdl),'nmetaaryi=',nmetaaryi(mybdl),'nmetavarr4=',nmetavarr4(mybdl), & +! 'nmetavarr8=',nmetavarr8(mybdl) +! +! get value: + if (nmetavari(mybdl) > 0) then + if(.not.allocated(variname)) allocate(variname(100,nbdl),varival(100,nbdl)) + endif + if (nmetavarr4(mybdl) > 0) then + if(.not.allocated(varr4name)) allocate(varr4name(100,nbdl),varr4val(100,nbdl)) + endif + if (nmetavarr8(mybdl) > 0) then + if(.not.allocated(varr8name)) allocate(varr8name(100,nbdl),varr8val(100,nbdl)) + endif + if (nmetavarc(mybdl) > 0) then + if(.not.allocated(varcname)) allocate(varcname(100,nbdl),varcval(100,nbdl)) + endif +! + ni=0; nr4=0; nr8=0; nc=0 + do i=1, attCount + + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + attnestflag=ESMF_ATTNEST_OFF, attributeIndex=i, name=attName, & + typekind=typekind, rc=rc) + + if (typekind==ESMF_TYPEKIND_I4 ) then + ni = ni + 1 + variname(ni,mybdl) = trim(attName) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(variname(ni,mybdl)), value=varival(ni,mybdl), rc=rc) + if (trim(variname(ni,mybdl)) == 'ncnsto') ntrac=varival(ni,mybdl) + else if (typekind==ESMF_TYPEKIND_R4) then + nr4 = nr4 + 1 + varr4name(nr4,mybdl) = trim(attName) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(variname(nr4,mybdl)), value=varival(nr4,mybdl), rc=rc) + else if (typekind==ESMF_TYPEKIND_R8) then + nr8 = nr8 + 1 + varr8name(nr8,mybdl) = trim(attName) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(variname(nr8,mybdl)), value=varival(nr8,mybdl), rc=rc) + else if (typekind==ESMF_TYPEKIND_CHARACTER) then + nc = nc + 1 + varcname(nc,mybdl) = trim(attName) + call ESMF_AttributeGet(fldbundle, convention="NetCDF", purpose="FV3", & + name=trim(varcname(nc,mybdl)), value=varcval(nc,mybdl), rc=rc) + endif + +! if(nmetavari(mybdl)>0) print *,'variname=',variname(1,mybdl),'varival=',varival(1,mybdl) +! if(nmetavarc(mybdl)>0) print *,'varcname=',varcname(1,mybdl),'varcval=',varcval(1,mybdl) +! + if( nmetavari(mybdl)>0 .or. nmetavarc(mybdl)>0 .or. nmetavarr4(mybdl) >0 .or. nmetavarr8(mybdl)>0) then + extrameta(mybdl) = .true. + else + extrameta(mybdl) = .false. + endif + + enddo + + end subroutine get_global_attr +! +!---------------------------------------------------------------------------------------- + +end module module_write_nemsio diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 477fbe4b7..d60a6045a 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -21,14 +21,16 @@ module module_wrt_grid_comp !*** Revision history !*** ! Jul 2017: J. Wang/G. Theurich - initial code for fv3 write grid component +! Aug 2017: J. Wang - add nemsio binary output for Gaussian grid ! !--------------------------------------------------------------------------------- ! use esmf use write_internal_state use module_fv3_io_def, only : num_pes_fcst,lead_wrttask, last_wrttask, & - n_group,write_netcdfflag, num_files, & + n_group, num_files, write_nemsiofile, & filename_base, output_grid, imo, jmo + use module_write_nemsio, only : nemsio_first_call, write_nemsio ! !----------------------------------------------------------------------- ! @@ -49,6 +51,7 @@ module module_wrt_grid_comp integer,save :: ntasks !<-- # of write tasks in the current group integer,save :: mytile !<-- the tile number in write task + integer,save :: wrt_mpi_comm !<-- the mpi communicator in the write comp logical,save :: first_init=.false. logical,save :: first_run=.false. ! @@ -124,6 +127,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) integer :: ISTAT, tl, i, j, k,date(6) integer,dimension(2,6) :: decomptile integer :: FBcount, fieldCount + integer :: vm_mpi_comm character(40) :: fieldName, axesname,longname type(ESMF_Grid) :: wrtGrid, fcstGrid type(ESMF_Array) :: array_work, array @@ -148,13 +152,15 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) real(ESMF_KIND_R4) :: valueR4 real(ESMF_KIND_R8) :: valueR8 - integer :: attCount, axeslen, jidx - real, dimension(:), allocatable :: slat, axesdata - real, dimension(:,:), pointer :: lonPtr, latPtr + integer :: attCount, axeslen, jidx, idate(7) + real, dimension(:), allocatable :: slat, lat, axesdata + real(ESMF_KIND_R8), dimension(:,:), pointer :: lonPtr, latPtr type(ESMF_DataCopy_Flag) :: copyflag=ESMF_DATACOPY_REFERENCE real(8),parameter :: PI=3.14159265358979d0 ! logical,save :: first=.true. +!test + integer myattCount ! !----------------------------------------------------------------------- !*********************************************************************** @@ -184,16 +190,20 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) allocate(wrt_int_state%wrtFB(num_files)) ! call ESMF_VMGetCurrent(vm=VM,rc=RC) - CALL ESMF_VMGet(vm=VM, localPet=wrt_int_state%mype, & - petCount=wrt_int_state%petcount, rc=rc) + call ESMF_VMGet(vm=VM, localPet=wrt_int_state%mype, & + petCount=wrt_int_state%petcount,mpiCommunicator=vm_mpi_comm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call mpi_comm_dup(vm_mpi_comm,wrt_mpi_comm,rc) ntasks = wrt_int_state%petcount jidx = wrt_int_state%petcount/6 - lead_write_task = lead_wrttask(n_group) - last_write_task = last_wrttask(n_group) - wrt_int_state%write_netcdfflag = write_netcdfflag - print *,'in wrt, lead_write_task=', & - lead_write_task,'last_write_task=',last_write_task, & - 'mype=',wrt_int_state%mype,'jidx=',jidx + lead_write_task = 0 + last_write_task = ntasks -1 +! print *,'in wrt, lead_write_task=', & +! lead_write_task,'last_write_task=',last_write_task, & +! 'mype=',wrt_int_state%mype,'jidx=',jidx,' comm=',wrt_mpi_comm ! !----------------------------------------------------------------------- !*** Create the cubed sphere grid with field on PETs @@ -209,16 +219,20 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) enddo wrtgrid = ESMF_GridCreateMosaic(filename='INPUT/grid_spec.nc', & regDecompPTile=decomptile,tileFilePath='INPUT/', & + staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & name='wrt_grid', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out else if ( trim(output_grid) == 'gaussian_grid') then + wrtgrid = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & - countsPerDEDim1=(/imo/), & - countsPerDEDim2=(/jmo/), & - indexflag=ESMF_INDEX_GLOBAL, coordSys=ESMF_COORDSYS_SPH_DEG, rc=rc) + maxIndex=(/imo,jmo/), regDecomp=(/1,ntasks/), & + indexflag=ESMF_INDEX_GLOBAL, & + name='wrt_grid',rc=rc) +! indexflag=ESMF_INDEX_GLOBAL, coordSys=ESMF_COORDSYS_SPH_DEG + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -240,13 +254,23 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) file=__FILE__)) & return ! bail out ! + allocate(slat(jmo),lat(jmo)) call splat(4,jmo, slat) + do j=1,jmo + lat(jmo-j+1) = asin(slat(j)) * 180./pi + enddo do j=lbound(lonPtr,2),ubound(lonPtr,2) do i=lbound(lonPtr,1),ubound(lonPtr,1) lonPtr(i,j) = 360./real(imo) * (i-1) - latPtr(i,j) = asin(slat(j)) * 180./pi + latPtr(i,j) = lat(j) enddo enddo +! print *,'aft wrtgrd, Gaussian, dimi,i=',lbound(lonPtr,1),ubound(lonPtr,1), & +! ' j=',lbound(lonPtr,2),ubound(lonPtr,2),'imo=',imo,'jmo=',jmo +! print *,'aft wrtgrd, lon=',lonPtr(lbound(lonPtr,1),lbound(lonPtr,2)), & +! lonPtr(lbound(lonPtr,1),ubound(lonPtr,2)),'lat=',latPtr(lbound(lonPtr,1),lbound(lonPtr,2)), & +! latPtr(lbound(lonPtr,1),ubound(lonPtr,2)) + deallocate(slat,lat) else if ( trim(output_grid) == 'latlon_grid') then wrtgrid = ESMF_GridCreate1PeriDimUfrm(maxIndex=(/imo, jmo/), & minCornerCoord=(/0._ESMF_KIND_R8, -80._ESMF_KIND_R8/), & @@ -300,8 +324,8 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) call ESMF_StateGet(imp_state_write, itemName=fcstItemNameList(i), & fieldbundle=fcstFB, rc=rc) - if(wrt_int_state%mype == lead_write_task) print *,'in wrt,i=',i,' fcstitem,name=',& - trim(fcstItemNameList(i)),' rc=',rc +! if(wrt_int_state%mype == lead_write_task) print *,'in wrt,i=',i,' fcstitem,name=',& +! trim(fcstItemNameList(i)),' rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -309,8 +333,8 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) wrt_int_state%wrtFB_names(i) = "mirror_"//trim(fcstItemNameList(i)) wrt_int_state%wrtFB(i) = ESMF_FieldBundleCreate(name=trim(wrt_int_state%wrtFB_names(i)), rc=rc) - if(wrt_int_state%mype == lead_write_task) print *,'in wrt,wrtfb create,rc=',rc, & - 'wrtFB_name=',trim( wrt_int_state%wrtFB_names(i)) +! if(wrt_int_state%mype == lead_write_task) print *,'in wrt,wrtfb create,rc=',rc, & +! 'wrtFB_name=',trim( wrt_int_state%wrtFB_names(i)) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -318,14 +342,12 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) ! create a mirror FieldBundle and add it to importState fieldbundle = ESMF_FieldBundleCreate(name="mirror_"//trim(fcstItemNameList(i)), rc=rc) - if(wrt_int_state%mype == lead_write_task) print *,'in wrt,wrt fieldbundle create,rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out call ESMF_StateAdd(imp_state_write, (/fieldbundle/), rc=rc) - if(wrt_int_state%mype == lead_write_task) print *,'in wrt,add wrt fieldbundle to state,rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -334,11 +356,18 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) ! copy the fcstFB Attributes to the mirror FieldBundle call ESMF_AttributeCopy(fcstFB, wrt_int_state%wrtFB(i), & attcopy=ESMF_ATTCOPY_REFERENCE, rc=rc) - if(wrt_int_state%mype == lead_write_task) print *,'in wrt,attribute copy wrt fieldbundle,rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out +! +! test: +! call ESMF_Attributeget(fcstFB, convention="NetCDF", purpose="FV3", & +! attnestflag=ESMF_ATTNEST_OFF,count=myattCount, rc=rc) +! print *,'test get attcount from fcstFB,myattCount=',myattCount,'rc=',rc +! call ESMF_Attributeget(wrt_int_state%wrtFB(i), convention="NetCDF", purpose="FV3", & +! attnestflag=ESMF_ATTNEST_OFF,count=myattCount, rc=rc) +! print *,'test get attcount from wrt_int_state%wrtFB, i=',i,'myattCount=',myattCount,'rc=',rc call ESMF_FieldBundleGet(fcstFB, fieldCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -346,7 +375,7 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) file=__FILE__)) & return ! bail out wrt_int_state%ncount_fields(i) = fieldCount - if(wrt_int_state%mype == lead_write_task) print *,'in wrt,fieldCount=',fieldCount +! if(wrt_int_state%mype == lead_write_task) print *,'in wrt,fieldCount=',fieldCount allocate(fcstField(fieldCount)) call ESMF_FieldBundleGet(fcstFB, fieldList=fcstField, & @@ -721,6 +750,8 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) call ESMF_TimeGet(time=wrt_int_state%IO_BASETIME,yy=date(1),mm=date(2),dd=date(3),h=date(4), & m=date(5),s=date(6),rc=rc) if(wrt_int_state%mype == lead_write_task) print *,'in wrt initial, io_baseline time=',date,'rc=',rc + idate(1:6) = date(1:6) + idate(7) = 1 ! !----------------------------------------------------------------------- !*** SET THE FIRST HISTORY FILE'S TIME INDEX. @@ -729,6 +760,17 @@ subroutine wrt_initialize(wrt_comp, imp_state_write, exp_state_write, clock, rc) wrt_int_state%NFHOUR = 0 ! !----------------------------------------------------------------------- +!*** Initialize for nemsio file +!----------------------------------------------------------------------- +! + if(trim(output_grid) == 'gaussian_grid' .and. write_nemsiofile) then + do i= 1, FBcount + call nemsio_first_call(wrt_int_state%wrtFB(i), imo, jmo, & + wrt_int_state%mype, ntasks, wrt_mpi_comm, FBcount, i, idate, rc) + enddo + endif +! +!----------------------------------------------------------------------- ! IF(RC /= ESMF_SUCCESS) THEN WRITE(0,*)"FAIL: Write_Initialize." @@ -797,7 +839,6 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) ! character(filename_maxstr) :: filename,compname,bundle_name character(3) :: cfhour - character(1) :: ctile character(10) :: stepString character(80) :: attrValueS integer :: attrValueI @@ -816,6 +857,8 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) character(80),allocatable :: field_names(:) real(kind=ESMF_KIND_R8), dimension(:,:,:), pointer :: datar8 real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d +! + integer myattCount ! !----------------------------------------------------------------------- !*********************************************************************** @@ -832,153 +875,172 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) line=__LINE__, & file=__FILE__)) & return ! bail out - print *,'in wrt run. compname=',trim(compname),' rc=',rc +! print *,'in wrt run. compname=',trim(compname),' rc=',rc ! instance id from name - read(compname(10:11),"(I2)") id + read(compname(10:11),"(I2)") id ! Provide log message indicating which wrtComp is active - call ESMF_LogWrite("Write component activated: "//trim(compname), & - ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_LogWrite("Write component activated: "//trim(compname), & + ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! access the internal state - call ESMF_GridCompGetInternalState(wrt_Comp, wrap, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - wrt_int_state => wrap%write_int_state + call ESMF_GridCompGetInternalState(wrt_Comp, wrap, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + wrt_int_state => wrap%write_int_state - call ESMF_VMGetCurrent(VM,rc=RC) - mype = wrt_int_state%mype - print *,'in wrt run, mype=',mype,'lead_write_task=',lead_write_task + call ESMF_VMGetCurrent(VM,rc=RC) + mype = wrt_int_state%mype +! print *,'in wrt run, mype=',mype,'lead_write_task=',lead_write_task ! !----------------------------------------------------------------------- !*** get current time and elapsed forecast time - call ESMF_ClockGet(clock=CLOCK, currTime=CURRTIME, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_TimeGet(time=currTime,yy=date(1),mm=date(2),dd=date(3),h=date(4), & + call ESMF_ClockGet(clock=CLOCK, currTime=CURRTIME, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_TimeGet(time=currTime,yy=date(1),mm=date(2),dd=date(3),h=date(4), & m=date(5),s=date(6),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if(mype == lead_write_task) print *,'in wrt run, curr time=',date + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! if(mype == lead_write_task) print *,'in wrt run, curr time=',date ! - call ESMF_TimeGet(time=wrt_int_state%IO_BASETIME,yy=date(1),mm=date(2),dd=date(3),h=date(4), & + call ESMF_TimeGet(time=wrt_int_state%IO_BASETIME,yy=date(1),mm=date(2),dd=date(3),h=date(4), & m=date(5),s=date(6),rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - if(mype == lead_write_task) print *,'in wrt run, io_baseline time=',date + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +! print *,'in wrt run, io_baseline time=',date ! - wrt_int_state%IO_CURRTIMEDIFF = CURRTIME-wrt_int_state%IO_BASETIME + wrt_int_state%IO_CURRTIMEDIFF = CURRTIME-wrt_int_state%IO_BASETIME ! - call ESMF_TimeIntervalGet(timeinterval=wrt_int_state%IO_CURRTIMEDIFF & + call ESMF_TimeIntervalGet(timeinterval=wrt_int_state%IO_CURRTIMEDIFF & ,h =nf_hours & !<-- Hours of elapsed time ,m =nf_minutes & !<-- Minutes of elapsed time ,s =nseconds & !<-- Seconds of elapsed time ,sN =nseconds_num & !<-- Numerator of fractional elapsed seconds ,sD =nseconds_den & !<-- denominator of fractional elapsed seconds ,rc =RC) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! - nf_seconds = nf_hours*3600+nf_minuteS*60+nseconds+real(nseconds_num)/real(nseconds_den) - wrt_int_state%nfhour = nf_seconds/3600. - write(cfhour,'(I3.3)')int(wrt_int_state%nfhour) + nf_seconds = nf_hours*3600+nf_minuteS*60+nseconds+real(nseconds_num)/real(nseconds_den) + wrt_int_state%nfhour = nf_seconds/3600. + write(cfhour,'(I3.3)')int(wrt_int_state%nfhour) - write(ctile,'(I1.1)')mytile - if(mype == lead_write_task) print *,'in wrt run, cfhour=',cfhour, & - 'mytile=',ctile,' nf_seconds=',nf_seconds,wrt_int_state%nfhour +! if(mype == lead_write_task) print *,'in wrt run, cfhour=',cfhour, & +! print *,'in wrt run, cfhour=',cfhour, & +! ' nf_seconds=',nf_seconds,wrt_int_state%nfhour ! access the time Attribute which is updated by the driver each time - call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & - name="time", value=time, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & + name="time", value=time, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out ! !----------------------------------------------------------------------- !*** loop on the files that need to write out !----------------------------------------------------------------------- - file_loop_all: do nbdl=1, wrt_int_state%FBCount + file_loop_all: do nbdl=1, wrt_int_state%FBCount ! - if(step == 1) then - call ESMF_StateGet(state=imp_state_write, & + if(step == 1) then + call ESMF_StateGet(state=imp_state_write, & itemName=wrt_int_state%wrtFB_names(NBDL),& fieldbundle=file_bundle, rc=rc) - if(mype == lead_write_task) print *,'in wrt run,nbdl=',nbdl,'fbname=', & - trim(wrt_int_state%wrtFB_names(NBDL)),'rc=',rc - endif +! if(mype == lead_write_task) print *,'in wrt run,nbdl=',nbdl,'fbname=', & +! trim(wrt_int_state%wrtFB_names(NBDL)),'rc=',rc + endif + + idx= index(wrt_int_state%wrtFB_names(nbdl)(8:),"_") + if (write_nemsiofile ) then + filename = wrt_int_state%wrtFB_names(nbdl)(8:7+idx-1)//'.f'//cfhour//'.nemsio' + else + filename = wrt_int_state%wrtFB_names(nbdl)(8:7+idx-1)//'.f'//cfhour//'.nc' + endif + if(mype == lead_write_task) print *,'in wrt run,filename=',trim(filename) + +! +! call ESMF_Attributeget(wrt_int_state%wrtFB(NBDL), convention="NetCDF", purpose="FV3", & +! attnestflag=ESMF_ATTNEST_OFF,count=myattCount, rc=rc) +! print *,'test get attcount from wrt_int_state%wrtFB, nbdl=',nbdl,'myattCount=',myattCount,'rc=',rc +! call ESMF_Attributeget(file_bundle, convention="NetCDF", purpose="FV3", & +! attnestflag=ESMF_ATTNEST_OFF,count=myattCount, rc=rc) +! print *,'test get attcount from wrt_grid_comp file_bundle, nbdl=',nbdl,'myattCount=',myattCount,'rc=',rc, & +! 'step=',step - idx= index(wrt_int_state%wrtFB_names(nbdl),"_", back=.true.) - filename = wrt_int_state%wrtFB_names(nbdl)(8:idx-1)//'.f'//cfhour//'.nc' - if(mype == lead_write_task) print *,'in wrt run,filename=',trim(filename), & - 'step=',step ! ! set the time Attribute on the grid to carry it into the lower levels - call ESMF_FieldBundleGet(file_bundle, grid=fbgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_AttributeSet(fbgrid, convention="NetCDF", purpose="FV3", & - name="time", value=real(wrt_int_state%nfhour,ESMF_KIND_R8), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + call ESMF_FieldBundleGet(file_bundle, grid=fbgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_AttributeSet(fbgrid, convention="NetCDF", purpose="FV3", & + name="time", value=real(wrt_int_state%nfhour,ESMF_KIND_R8), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out !*** write out grid bundle: ! Provide log message indicating which wrtComp is active - call ESMF_LogWrite("before Write component before gridFB ", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) & - return ! bail out + call ESMF_LogWrite("before Write component before gridFB ", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) & + return ! bail out ! tbeg0 = MPI_Wtime() + if(trim(output_grid) == 'gaussian_grid' .and. write_nemsiofile) then + call write_nemsio(file_bundle,trim(filename),nf_hours, nf_minutes, & + nf_seconds, nbdl, rc) - call ESMFproto_FieldBundleWrite(gridFB, filename=trim(filename), & - convention="NetCDF", purpose="FV3", & - status=ESMF_FILESTATUS_REPLACE, state=stateGridFB, comps=compsGridFB,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) & - return ! bail out - if(mype == lead_write_task) print *,'in wrt run aft write grid bundle, rc=',rc - - call ESMF_LogWrite("after Write component before gridFB ", ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) & - return ! bail out +! if(mype == lead_write_task) print *,'in wrt run aft write nemsio grid bundle, rc=',rc ! - filestatus = ESMF_FILESTATUS_OLD - call ESMF_LogWrite("before ESMFproto_FieldBundleWrite dyn",ESMF_LOGMSG_INFO,rc=RC) - call ESMFproto_FieldBundleWrite(wrt_int_state%wrtFB(nbdl), & - filename=trim(filename), convention="NetCDF", purpose="FV3", & - status=filestatus, timeslice=step, state=optimize(nbdl)%state, & - comps=optimize(nbdl)%comps, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out - call ESMF_LogWrite("aft ESMFproto_FieldBundleWrite dyn",ESMF_LOGMSG_INFO,rc=RC) -! print *,'after writing file nbdl=',nbdl,'FBcount=',wrt_int_state%FBCount + else + + call ESMFproto_FieldBundleWrite(gridFB, filename=trim(filename), & + convention="NetCDF", purpose="FV3", & + status=ESMF_FILESTATUS_REPLACE, state=stateGridFB, comps=compsGridFB,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) & + return ! bail out + call ESMF_LogWrite("after Write component before gridFB ", ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) & + return ! bail out + + filestatus = ESMF_FILESTATUS_OLD + + call ESMF_LogWrite("before ESMFproto_FieldBundleWrite dyn",ESMF_LOGMSG_INFO,rc=RC) + call ESMFproto_FieldBundleWrite(wrt_int_state%wrtFB(nbdl), & + filename=trim(filename), convention="NetCDF", purpose="FV3", & + status=filestatus, timeslice=step, state=optimize(nbdl)%state, & + comps=optimize(nbdl)%comps, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite("aft ESMFproto_FieldBundleWrite dyn",ESMF_LOGMSG_INFO,rc=RC) + + endif -! enddo file_loop_all ! !----------------------------------------------------------------------- @@ -987,8 +1049,8 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) ! IF(RC /= ESMF_SUCCESS) THEN WRITE(0,*)"FAIL: WRITE_RUN" -! ELSE -! WRITE(0,*)"PASS: WRITE_RUN" +! ELSE +! WRITE(0,*)"PASS: WRITE_RUN" ENDIF ! write_run_tim=MPI_Wtime()-tbeg @@ -1206,10 +1268,10 @@ subroutine ESMFproto_FieldBundleWrite(fieldbundle, fileName, & file=__FILE__)) & return ! bail out enddo - write(msgString, *) petList - call ESMF_LogWrite("In ESMFproto_FieldBundleWrite() after "// & - "ESMFproto_FieldMakeSingleTile(), petList:"//trim(msgString), & - ESMF_LOGMSG_INFO, rc=rc) +! write(msgString, *) petList +! call ESMF_LogWrite("In ESMFproto_FieldBundleWrite() after "// & +! "ESMFproto_FieldMakeSingleTile(), petList:"//trim(msgString), & +! ESMF_LOGMSG_INFO, rc=rc) ! create component to handle this tile I/O call ESMF_LogWrite("In ESMFproto_FieldBundleWrite() before "// & "tile-component creation", ESMF_LOGMSG_INFO, rc=rc) @@ -1317,8 +1379,12 @@ subroutine ESMFproto_FieldBundleWrite(fieldbundle, fileName, & wrtTileFB = wrtTileFBList(i) endif ! write out the tile specific fieldbundle - ind=min(index(trim(fileName),".nc",.true.)-1,len_trim(fileName)) - write(tileFileName, "(A,A,I1,A)") fileName(1:ind), ".tile", i, ".nc" + if(tileCount>1) then + ind=min(index(trim(fileName),".nc",.true.)-1,len_trim(fileName)) + write(tileFileName, "(A,A,I1,A)") fileName(1:ind), ".tile", i, ".nc" + else + tileFileName=trim(fileName) + endif if (present(comps)) then ioState(i) = ESMF_StateCreate(rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1466,7 +1532,8 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) integer :: localPet, i, j, k, ind type(ESMF_Grid) :: grid - real(ESMF_KIND_R8), allocatable :: valueList(:) + real(ESMF_KIND_R4), allocatable :: valueListr4(:) + real(ESMF_KIND_R8), allocatable :: valueListr8(:) integer :: valueCount, fieldCount, udimCount character(80), allocatable :: udimList(:) integer :: ncerr, ncid, dimid, varid @@ -1704,6 +1771,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) attName=attNameList(i) call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), typekind=typekind, rc=rc) +! print *,'in esmf call, att name=',trim(attNameList(i)) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1712,6 +1780,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueS, rc=rc) +! print *,'in esmf call, att string value=',trim(valueS) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1726,6 +1795,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueI4, rc=rc) +! print *,'in esmf call, att I4 value=',valueR8 if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1740,6 +1810,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueR4, rc=rc) +! print *,'in esmf call, att r4 value=',valueR8 if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1754,6 +1825,7 @@ subroutine ioCompRun(comp, importState, exportState, clock, rc) call ESMF_AttributeGet(grid, & convention="NetCDF", purpose="FV3", & name=trim(attNameList(i)), value=valueR8, rc=rc) +! print *,'in esmf call, att r8 value=',valueR8 if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & @@ -1847,18 +1919,28 @@ subroutine write_out_ungridded_dim_atts(dimLabel, rc) ! the variable does not exist in the NetCDF file yet -> add it ! access the undistributed dimension attribute on the grid call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - name=trim(dimLabel), itemCount=valueCount, rc=rc) + name=trim(dimLabel), itemCount=valueCount, typekind=typekind, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & return ! bail out - allocate(valueList(valueCount)) - call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & - name=trim(dimLabel), valueList=valueList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__)) & - return ! bail out + if( typekind == ESMF_TYPEKIND_R4 ) then + allocate(valueListr4(valueCount)) + call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & + name=trim(dimLabel), valueList=valueListr4, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else if ( typekind == ESMF_TYPEKIND_R8) then + allocate(valueListr8(valueCount)) + call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & + name=trim(dimLabel), valueList=valueListr8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif ! now add it to the NetCDF file ncerr = nf90_redef(ncid=ncid) if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, & @@ -1875,23 +1957,43 @@ subroutine write_out_ungridded_dim_atts(dimLabel, rc) file=__FILE__, rcToReturn=rc)) & return ! bail out endif - ncerr = nf90_def_var(ncid, trim(dimLabel), NF90_DOUBLE, & - dimids=(/dimid/), varid=varid) - if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__, rcToReturn=rc)) & - return ! bail out - ncerr = nf90_enddef(ncid=ncid) - if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__, rcToReturn=rc)) & - return ! bail out - ncerr = nf90_put_var(ncid, varid, values=valueList) - if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, & - file=__FILE__, rcToReturn=rc)) & - return ! bail out - deallocate(valueList) + if( typekind == ESMF_TYPEKIND_R4 ) then + ncerr = nf90_def_var(ncid, trim(dimLabel), NF90_FLOAT, & + dimids=(/dimid/), varid=varid) + if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out + ncerr = nf90_enddef(ncid=ncid) + if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out + ncerr = nf90_put_var(ncid, varid, values=valueListr4) + if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out + deallocate(valueListr4) + else if(typekind == ESMF_TYPEKIND_R8) then + ncerr = nf90_def_var(ncid, trim(dimLabel), NF90_DOUBLE, & + dimids=(/dimid/), varid=varid) + if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out + ncerr = nf90_enddef(ncid=ncid) + if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out + ncerr = nf90_put_var(ncid, varid, values=valueListr8) + if (ESMF_LogFoundNetCDFError(ncerr, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__, rcToReturn=rc)) & + return ! bail out + deallocate(valueListr8) + endif ! add attributes to this vertical variable call ESMF_AttributeGet(grid, convention="NetCDF", purpose="FV3", & attnestflag=ESMF_ATTNEST_OFF, count=attCount, rc=rc) diff --git a/makefile b/makefile index 406c3cbf3..fe2ef1636 100644 --- a/makefile +++ b/makefile @@ -35,7 +35,7 @@ time_utils.o: time_utils.F90 fv3_cap.o: fv3_cap.F90 $(FC) $(CPPDEFS) $(CPPFLAGS) $(FPPFLAGS) $(FFLAGS) $(OTHERFLAGS) $(OTHER_FFLAGS) $(ESMF_INC) -c fv3_cap.F90 -DEPEND_FILES = time_utils.F90 atmos_model.F90 module_fcst_grid_comp.F90 fv3_cap.F90 coupler_main.F90 +DEPEND_FILES = time_utils.F90 module_fv3_config.F90 atmos_model.F90 module_fcst_grid_comp.F90 fv3_cap.F90 coupler_main.F90 esmf_make_fragment: @rm -rf nems_dir; mkdir nems_dir diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index 62e90c974..b154a5a61 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -349,6 +349,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) enddo fcstGrid = ESMF_GridCreateMosaic(filename='INPUT/grid_spec.nc', & regDecompPTile=decomptile,tileFilePath='INPUT/', & + staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & name='fcst_grid', rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -428,7 +429,11 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) do i=1,num_files ! name_FB = filename_base(i) - name_FB = trim(name_FB)//'_bilinear' + if( i==1 ) then + name_FB = trim(name_FB)//'_bilinear' + else if( i==2 ) then + name_FB = trim(name_FB)//'_nearest_stod' + endif fieldbundle = ESMF_FieldBundleCreate(name=trim(name_FB),rc=rc) if(mype==0) print *,'af create fcst fieldbundle, name=',trim(name_FB),'rc=',rc if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &