From 311582ca09f91feca75c7d411e620e3c28648019 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Sat, 6 May 2023 13:29:39 -0600 Subject: [PATCH 01/10] This fails to enable writing of 'daily' files from forecasts shorter than 24 hours --- cime_config/namelist_definition_drv.xml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d403caad1..d62eacc57 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1526,7 +1526,7 @@ MED_attributes history option type - ndays + nhours @@ -1989,7 +1989,7 @@ MED_attributes history option type - ndays + nhours @@ -1998,7 +1998,7 @@ MED_attributes history option type - 1 + 6 From 7ac3ca9a8d331ee6e09e43458478ed29626293f2 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 13:40:40 -0600 Subject: [PATCH 02/10] make history_n integer variables --- cime_config/namelist_definition_drv.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 0ade5db43..501d6896e 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1264,7 +1264,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1329,7 +1329,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1396,7 +1396,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1465,7 +1465,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1530,7 +1530,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1748,7 +1748,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1830,7 +1830,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1993,7 +1993,7 @@ - char + integer aux_hist MED_attributes history option type From b22ae222b571f7e5196052d581c74ce6d2611be0 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 13:44:49 -0600 Subject: [PATCH 03/10] sames should be samples --- cime_config/namelist_definition_drv.xml | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 501d6896e..5cbf78319 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1294,7 +1294,7 @@ integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 24 @@ -1350,7 +1350,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 24 @@ -1417,7 +1417,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 8 @@ -1486,7 +1486,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 8 @@ -1551,7 +1551,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 @@ -1769,7 +1769,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 @@ -1860,7 +1860,7 @@ integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 30 @@ -2014,7 +2014,7 @@ char aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 From cca94e4b7bf6e39fa19ddfc865749da08f8dccaa Mon Sep 17 00:00:00 2001 From: James Edwards Date: Wed, 10 May 2023 16:09:27 -0600 Subject: [PATCH 04/10] wopen should return rc --- mediator/med_io_mod.F90 | 33 ++++++++++++++--------------- mediator/med_phases_history_mod.F90 | 18 ++++++++++------ mediator/med_phases_restart_mod.F90 | 3 ++- 3 files changed, 30 insertions(+), 24 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 97db9bcc0..38ae201f2 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -7,7 +7,7 @@ module med_io_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, I8=>SHR_KIND_I8, R8=>SHR_KIND_R8 use med_kind_mod , only : R4=>SHR_KIND_R4 use med_constants_mod , only : fillvalue => SHR_CONST_SPVAL - use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast, ESMF_Finalize use NUOPC , only : NUOPC_FieldDictionaryGetEntry @@ -198,7 +198,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '64BIT_DATA') then pio_ioformat = PIO_64BIT_DATA else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -223,7 +223,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'NETCDF4P') then pio_iotype = PIO_IOTYPE_NETCDF4P else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -334,13 +334,13 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'SUBSET') then pio_rearranger = PIO_REARR_SUBSET else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if else - cvalue = 'BOX' - pio_rearranger = PIO_REARR_BOX + cvalue = 'SUBSET' + pio_rearranger = PIO_REARR_SUBSET end if if (localPet == 0) write(logunit,*) trim(subname), ' : pio_rearranger = ', trim(cvalue), pio_rearranger @@ -357,7 +357,7 @@ subroutine med_io_init(gcomp, rc) if (isPresent .and. isSet) then read(cvalue,*) pio_debug_level if (pio_debug_level < 0 .or. pio_debug_level > 6) then - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -381,7 +381,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'COLL') then pio_rearr_comm_type = PIO_REARR_COMM_COLL else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -406,7 +406,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '2DDISABLE') then pio_rearr_comm_fcd = PIO_REARR_COMM_FC_2D_DISABLE else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -498,7 +498,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -512,16 +512,15 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename type(ESMF_VM) :: vm + integer, intent(out) :: rc logical, optional, intent(in) :: clobber integer, optional, intent(in) :: file_ind character(CL), optional, intent(in) :: model_doi_url - ! local variables logical :: lclobber integer :: rcode integer :: nmode integer :: lfile_ind - integer :: rc integer :: iam character(CL) :: lversion character(CL) :: lmodel_doi_url @@ -539,10 +538,11 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - if (.not. pio_file_is_open(io_file(lfile_ind))) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (.not. pio_file_is_open(io_file(lfile_ind))) then ! filename not open wfilename(lfile_ind) = trim(filename) @@ -589,7 +589,7 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) end if - call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return @@ -848,7 +848,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif - rc = ESMF_Success return endif diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 2f7c9f062..00444b292 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -292,7 +292,8 @@ subroutine med_phases_history_write(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over whead/wdata phases do m = 1,2 @@ -463,7 +464,8 @@ subroutine med_phases_history_write_med(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -596,7 +598,8 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data to history file do m = 1,2 @@ -749,7 +752,8 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -953,7 +957,8 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then @@ -1276,7 +1281,8 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(auxcomp%files(nf)%histfile, vm, file_ind=nf, clobber=.true.) + call med_io_wopen(auxcomp%files(nf)%histfile, vm, rc, file_ind=nf, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 6bf5f3466..3b276b08e 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -309,7 +309,8 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(restart_file, vm, clobber=.true.) + call med_io_wopen(restart_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 if (m == 2) then From a31664644ec8e90d3a53bcc11602fc5e3eb6774f Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 10:23:32 -0600 Subject: [PATCH 05/10] major refactor of med_io_mod to handle multiple files --- mediator/med_io_mod.F90 | 345 +++++++++++----------------- mediator/med_phases_history_mod.F90 | 116 +++++----- mediator/med_phases_restart_mod.F90 | 53 ++--- 3 files changed, 227 insertions(+), 287 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 38ae201f2..9215777c0 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -77,8 +77,9 @@ module med_io_mod character(*),parameter :: version = "cmeps0" integer , parameter :: number_strlen = 8 integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - character(CL) :: wfilename(0:file_desc_t_cnt) = '' - type(file_desc_t) :: io_file(0:file_desc_t_cnt) + +! character(CL) :: wfilename(0:file_desc_t_cnt) = '' + integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem @@ -498,7 +499,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -511,6 +512,7 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename + type(file_desc_t), intent(inout) :: io_file type(ESMF_VM) :: vm integer, intent(out) :: rc logical, optional, intent(in) :: clobber @@ -542,10 +544,10 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not. pio_file_is_open(io_file(lfile_ind))) then + if (.not. pio_file_is_open(io_file)) then ! filename not open - wfilename(lfile_ind) = trim(filename) +! wfilename(lfile_ind) = trim(filename) if (med_io_file_exists(vm, filename)) then if (lclobber) then @@ -554,20 +556,20 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then nmode = ior(nmode,pio_ioformat) endif - rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + rcode = pio_createfile(io_subsystem, io_file, pio_iotype, trim(filename), nmode) if(iam==0) write(logunit,'(a)') trim(subname)//' creating file '//trim(filename) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) else - rcode = pio_openfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), pio_write) + rcode = pio_openfile(io_subsystem, io_file, pio_iotype, trim(filename), pio_write) if (iam==0) write(logunit,'(a)') trim(subname)//' opening file '//trim(filename) - call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) - rcode = pio_get_att(io_file(lfile_ind),pio_global,"file_version",lversion) - call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) + call pio_seterrorhandling(io_file,PIO_BCAST_ERROR) + rcode = pio_get_att(io_file,pio_global,"file_version",lversion) + call pio_seterrorhandling(io_file,PIO_INTERNAL_ERROR) if (trim(lversion) /= trim(version)) then - rcode = pio_redef(io_file(lfile_ind)) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_enddef(io_file(lfile_ind)) + rcode = pio_redef(io_file) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_enddef(io_file) endif endif else @@ -577,21 +579,21 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) nmode = ior(nmode,pio_ioformat) endif - rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + rcode = pio_createfile(io_subsystem, io_file, pio_iotype, trim(filename), nmode) if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) endif - elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then +! elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then ! filename is open, better match open filename - if (iam==0) then - write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) - write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) - end if - call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) - rc = ESMF_FAILURE - return +! if (iam==0) then +! write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) +! write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) +! end if +! call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) +! rc = ESMF_FAILURE +! return else ! filename is already open, just return @@ -600,7 +602,7 @@ subroutine med_io_wopen(filename, vm, rc, clobber, file_ind, model_doi_url) end subroutine med_io_wopen !=============================================================================== - subroutine med_io_close(filename, vm, file_ind, rc) + subroutine med_io_close(io_file, rc) !--------------- ! close netcdf file @@ -609,85 +611,52 @@ subroutine med_io_close(filename, vm, file_ind, rc) use pio, only: pio_file_is_open, pio_closefile ! input/output variables - character(*) , intent(in) :: filename - type(ESMF_VM) , intent(in) :: vm - integer,optional , intent(in) :: file_ind + type(file_desc_t) :: io_file integer , intent(out) :: rc ! local variables - integer :: lfile_ind + integer :: iam character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - - if (.not. pio_file_is_open(io_file(lfile_ind))) then - ! filename not open, just return - elseif (trim(wfilename(lfile_ind)) == trim(filename)) then - ! filename matches, close it - call pio_closefile(io_file(lfile_ind)) - !wfilename(lfile_ind) = '' - else - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! different filename is open, abort - if (iam==0) then - write(logunit,*) subname,' different wfilename and filename currently open, aborting ' - write(logunit,'(a)') 'filename = ',trim(filename) - write(logunit,'(a)') 'wfilename = ',trim(wfilename(lfile_ind)) - write(logunit,'(i6)')'lfile_ind = ',lfile_ind - end if - call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if + if (pio_file_is_open(io_file)) then + call pio_closefile(io_file) endif end subroutine med_io_close !=============================================================================== - subroutine med_io_redef(filename,file_ind) + subroutine med_io_redef(io_file) use pio, only : pio_redef ! input/output variables - character(len=*), intent(in) :: filename - integer,optional,intent(in):: file_ind - + type(file_desc_t) :: io_file ! local variables - integer :: lfile_ind integer :: rcode !------------------------------------------------------------------------------- - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - rcode = pio_redef(io_file(lfile_ind)) + rcode = pio_redef(io_file) end subroutine med_io_redef !=============================================================================== - subroutine med_io_enddef(filename,file_ind) + subroutine med_io_enddef(io_file) use pio, only : pio_enddef ! input/output variables - character(len=*) , intent(in) :: filename - integer,optional , intent(in) :: file_ind + type(file_desc_t) :: io_file ! local variables - integer :: lfile_ind + integer :: rcode !------------------------------------------------------------------------------- - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - rcode = pio_enddef(io_file(lfile_ind)) + rcode = pio_enddef(io_file) end subroutine med_io_enddef @@ -746,8 +715,8 @@ character(len=8) function med_io_sec2hms (seconds, rc) end function med_io_sec2hms !=============================================================================== - subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & - fillval, pre, flds, tavg, use_float, file_ind, tilesize, rc) + subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & + fillval, pre, flds, tavg, use_float, tilesize, rc) !--------------- ! Write FB to netcdf file @@ -765,7 +734,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & use pio , only : pio_syncfile ! input/output variables - character(len=*) , intent(in) :: filename ! file + type(file_desc_t) :: io_file type(ESMF_FieldBundle) , intent(in) :: FB ! data to be written logical , intent(in) :: whead ! write header logical , intent(in) :: wdata ! write data @@ -777,7 +746,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out logical, optional , intent(in) :: tavg ! is this a tavg logical, optional , intent(in) :: use_float ! write output as float rather than double - integer, optional , intent(in) :: file_ind integer, optional , intent(in) :: tilesize ! if non-zero, write atm component on tiles integer , intent(out):: rc @@ -811,7 +779,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & integer, pointer :: maxIndexPTile(:,:) integer :: dimCount, tileCount integer, pointer :: Dof(:) - integer :: lfile_ind real(r8), pointer :: fldptr1(:) real(r8), pointer :: fldptr2(:,:) real(r8), allocatable :: ownedElemCoords(:), ownedElemCoords_x(:), ownedElemCoords_y(:) @@ -835,8 +802,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (present(pre)) lpre = trim(pre) luse_float = .false. if (present(use_float)) luse_float = use_float - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind + atmtiles = .false. if (present(tilesize)) then if (tilesize > 0) atmtiles = .true. @@ -953,22 +919,22 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Write header if (whead) then if (atmtiles) then - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid3(1)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid3(2)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ntiles', ntiles, dimid3(3)) + rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntiles', ntiles, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 - rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid4(4)) + rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) dimid => dimid4 else dimid => dimid3 endif else - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid2(1)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid2(2)) + rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid2(1)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid2(2)) if (present(nt)) then dimid3(1:2) = dimid2 - rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid3(3)) + rcode = pio_inq_dimid(io_file, 'time', dimid3(3)) dimid => dimid3 else dimid => dimid2 @@ -1007,21 +973,21 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid,"_FillValue",real(lfillvalue,r4)) + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid,"_FillValue",real(lfillvalue,r4)) else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",lfillvalue) + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file,varid,"_FillValue",lfillvalue) end if if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file, varid, "units" , trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") endif endif end if @@ -1030,21 +996,21 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & name1 = trim(lpre)//'_'//trim(itemc) call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO) if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", real(lfillvalue, r4)) + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", real(lfillvalue, r4)) else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", lfillvalue) + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", lfillvalue) end if if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) + rcode = pio_put_att(io_file, varid, "units", trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") endif end if end if @@ -1054,13 +1020,13 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Add coordinate information to file do n = 1,ndims if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_REAL, dimid, varid) + rcode = pio_def_var(io_file, trim(coordvarnames(n)), PIO_REAL, dimid, varid) else - rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) + rcode = pio_def_var(io_file, trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", trim(coordnames(n))) - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(coordunits(n))) - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(coordnames(n))) + rcode = pio_put_att(io_file, varid, "long_name", trim(coordnames(n))) + rcode = pio_put_att(io_file, varid, "units", trim(coordunits(n))) + rcode = pio_put_att(io_file, varid, "standard_name", trim(coordnames(n))) end do end if @@ -1106,38 +1072,38 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & do n = 1,ungriddedUBound(1) write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) + rcode = pio_inq_varid(io_file, trim(name1), varid) + call pio_setframe(io_file,varid,frame) if (gridToFieldMap(1) == 1) then - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) else if (gridToFieldMap(1) == 2) then - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) end if end do else if (rank == 1 .or. rank == 0) then name1 = trim(lpre)//'_'//trim(itemc) - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) + rcode = pio_inq_varid(io_file, trim(name1), varid) + call pio_setframe(io_file,varid,frame) ! fix for writing data on exchange grid, which has no data in some PETs if (rank == 0) nullify(fldptr1) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue) end if ! end if rank is 2 or 1 or 0 end if ! end if not "hgt" end do ! end loop over fields in FB ! Fill coordinate variables - why is this being done each time? - rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(1)), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) + rcode = pio_inq_varid(io_file, trim(coordvarnames(1)), varid) + call pio_setframe(io_file,varid,frame) + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) - rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(2)), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) + rcode = pio_inq_varid(io_file, trim(coordvarnames(2)), varid) + call pio_setframe(io_file,varid,frame) + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) - call pio_syncfile(io_file(lfile_ind)) - call pio_freedecomp(io_file(lfile_ind), iodesc) + call pio_syncfile(io_file) + call pio_freedecomp(io_file, iodesc) endif deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) @@ -1148,7 +1114,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & end subroutine med_io_write_FB !=============================================================================== - subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int(io_file, idata, dname, whead, wdata, rc) use pio, only : var_desc_t, pio_def_var, pio_put_att, pio_int, pio_inq_varid, pio_put_var @@ -1157,45 +1123,40 @@ subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) !--------------- ! intput/output variables - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file integer ,intent(in) :: idata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_int) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (whead) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_def_var(io_file,trim(dname),PIO_INT,varid) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) endif if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,idata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,idata) endif end subroutine med_io_write_int !=============================================================================== - subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int1d(io_file, idata, dname, whead, wdata, file_ind, rc) !--------------- ! Write 1d integer array to netcdf file @@ -1206,7 +1167,7 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc use pio , only : pio_int, pio_def_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file integer ,intent(in) :: idata(:) ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header @@ -1233,21 +1194,21 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if lnx = size(idata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname),lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,dimid,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_def_dim(io_file,trim(dname),lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_INT,dimid,varid) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) else if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,idata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,idata) endif end subroutine med_io_write_int1d !=============================================================================== - subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r8(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write scalar double to netcdf file @@ -1257,48 +1218,41 @@ subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_double, pio_noerr, pio_inq_varid, pio_put_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_T) :: io_file real(r8) ,intent(in) :: rdata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r8) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif if (whead) then - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) + rcode = pio_def_var(io_file,trim(dname),PIO_DOUBLE,varid) if (rcode==PIO_NOERR) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) end if else if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,rdata) endif end subroutine med_io_write_r8 !=============================================================================== - subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r81d(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write 1d double array to netcdf file @@ -1308,12 +1262,11 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_inq_varid, pio_put_var, pio_double, pio_put_att ! !INPUT/OUTPUT PARAMETERS: - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file real(r8) ,intent(in) :: rdata(:) ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables @@ -1322,38 +1275,32 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r81d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif if (whead) then lnx = size(rdata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) + rcode = pio_def_dim(io_file,trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_DOUBLE,dimid,varid) if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) endif if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,rdata) endif end subroutine med_io_write_r81d !=============================================================================== - subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_char(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write char string to netcdf file @@ -1363,12 +1310,11 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_char, pio_put_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file character(len=*) ,intent(in) :: rdata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables @@ -1377,37 +1323,32 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - integer :: lfile_ind character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_write_char) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif + if (whead) then lnx = len(charvar) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_CHAR,dimid,varid) + rcode = pio_def_dim(io_file,trim(dname)//'_len',lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_CHAR,dimid,varid) if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) else if (wdata) then charvar = '' charvar = trim(rdata) - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,charvar) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,charvar) endif end subroutine med_io_write_char !=============================================================================== - subroutine med_io_define_time(time_units, calendar, file_ind, rc) + subroutine med_io_define_time(io_file, time_units, calendar, rc) use ESMF, only : operator(==), operator(/=) use ESMF, only : ESMF_Calendar, ESMF_CalendarIsCreated @@ -1420,9 +1361,9 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) use pio , only : pio_inq_varid, pio_put_var ! input/output variables + type(file_desc_t) :: io_file character(len=*) , intent(in) :: time_units ! units of time type(ESMF_Calendar) , intent(in) :: calendar ! calendar - integer, optional , intent(in) :: file_ind integer , intent(out):: rc ! local variables @@ -1430,16 +1371,12 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) integer :: dimid(1) integer :: dimid2(2) type(var_desc_t) :: varid - integer :: lfile_ind character(CL) :: calname ! calendar name character(*),parameter :: subName = '(med_io_define_time) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (.not. ESMF_CalendarIsCreated(calendar)) then call ESMF_LogWrite(trim(subname)//' ERROR: calendar is not created ', & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) @@ -1448,9 +1385,9 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) end if ! define time and add calendar attribute - rcode = pio_def_dim(io_file(lfile_ind), 'time', PIO_UNLIMITED, dimid(1)) - rcode = pio_def_var(io_file(lfile_ind), 'time', PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, 'units', trim(time_units)) + rcode = pio_def_dim(io_file, 'time', PIO_UNLIMITED, dimid(1)) + rcode = pio_def_var(io_file, 'time', PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, 'units', trim(time_units)) if (calendar == ESMF_CALKIND_360DAY) then calname = '360_day' else if (calendar == ESMF_CALKIND_GREGORIAN) then @@ -1466,18 +1403,18 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) else if (calendar == ESMF_CALKIND_NOLEAP) then calname = 'noleap' end if - rcode = pio_put_att(io_file(lfile_ind), varid, 'calendar', trim(calname)) + rcode = pio_put_att(io_file, varid, 'calendar', trim(calname)) ! define time bounds dimid2(2) = dimid(1) - rcode = pio_def_dim(io_file(lfile_ind), 'ntb', 2, dimid2(1)) - rcode = pio_def_var(io_file(lfile_ind), 'time_bnds', PIO_DOUBLE, dimid2, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, 'bounds', 'time_bnds') + rcode = pio_def_dim(io_file, 'ntb', 2, dimid2(1)) + rcode = pio_def_var(io_file, 'time_bnds', PIO_DOUBLE, dimid2, varid) + rcode = pio_put_att(io_file, varid, 'bounds', 'time_bnds') end subroutine med_io_define_time !=============================================================================== - subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) + subroutine med_io_write_time(io_file, time_val, tbnds, nt, rc) !--------------- ! Write time variable to netcdf file @@ -1486,15 +1423,14 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) use pio, only : pio_put_att, pio_inq_varid, pio_put_var ! input/output variables + type(file_desc_t) :: io_file real(r8) , intent(in) :: time_val ! data to be written real(r8) , intent(in) :: tbnds(2) ! time bounds integer , intent(in) :: nt - integer , optional, intent(in) :: file_ind integer , intent(out):: rc ! local variables integer :: rcode - integer :: lfile_ind integer :: varid integer :: start(2),count(2) character(*),parameter :: subName = '(med_io_write_time) ' @@ -1502,19 +1438,16 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - ! write time count = 1; start = nt - rcode = pio_inq_varid(io_file(lfile_ind), 'time', varid) - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:1), count(1:1), (/time_val/)) + rcode = pio_inq_varid(io_file, 'time', varid) + rcode = pio_put_var(io_file, varid, start(1:1), count(1:1), (/time_val/)) ! write time bounds - rcode = pio_inq_varid(io_file(lfile_ind), 'time_bnds', varid) + rcode = pio_inq_varid(io_file, 'time_bnds', varid) start(1) = 1; start(2) = nt count(1) = 2; count(2) = 1 - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:2), count(1:2), tbnds) + rcode = pio_put_var(io_file, varid, start(1:2), count(1:2), tbnds) end subroutine med_io_write_time @@ -1537,7 +1470,7 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) use pio , only : pio_read_darray, pio_offset_kind, pio_setframe ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + character(len=*) ,intent(in) :: filename type(ESMF_VM) ,intent(in) :: vm type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read character(len=*) ,optional ,intent(in) :: pre ! prefix to variable name diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 00444b292..e647dc647 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -24,7 +24,8 @@ module med_phases_history_mod use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf - + use pio , only : file_desc_t + implicit none private @@ -59,6 +60,7 @@ module med_phases_history_mod ! Instantaneous history files datatypes/variables per component ! ---------------------------- type, public :: instfile_type + type(file_desc_t) :: io_file logical :: write_inst character(CS) :: hist_option integer :: hist_n @@ -74,6 +76,7 @@ module med_phases_history_mod ! Time averaging history files ! ---------------------------- type, public :: avgfile_type + type(file_desc_t) :: io_file logical :: write_avg type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging integer :: accumcnt_import ! field bundle accumulation counter @@ -93,6 +96,7 @@ module med_phases_history_mod ! Auxiliary history files ! ---------------------------- type, public :: auxfile_type + type(file_desc_t) :: io_file character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name @@ -155,6 +159,7 @@ subroutine med_phases_history_write(gcomp, rc) integer, intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(InternalState) :: is_local type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm @@ -292,23 +297,23 @@ subroutine med_phases_history_write(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over whead/wdata phases do m = 1,2 if (m == 2) then - call med_io_enddef(hist_file) + call med_io_enddef(io_file) end if ! Write time values if (whead(m)) then call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -316,49 +321,49 @@ subroutine med_phases_history_write(gcomp, rc) ! Write import and export field bundles if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end if ! Write mediator fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write component mediator area field bundles - call med_io_write(hist_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), rc=rc) end do ! Write atm/ocn fluxes and ocean albedoes if field bundles are created if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if end do ! end of loop over whead/wdata m index phases ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of write_now if-block @@ -464,44 +469,44 @@ subroutine med_phases_history_write_med(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, instfiles(compmed)%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(instfiles(compmed)%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(instfiles(compmed)%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(instfiles(compmed)%io_file) + call med_io_write_time(instfiles(compmed)%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write aoflux fields computed in mediator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if ! If appropriate - write ocn albedos computed in mediator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) end if end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(instfiles(compmed)%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of if-write_now block @@ -525,6 +530,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) integer , intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(InternalState) :: is_local type(ESMF_VM) :: vm type(ESMF_Clock) :: clock @@ -598,7 +604,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data to history file @@ -606,20 +612,20 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(io_file) + call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(hist_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + call med_io_write(io_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do ! end of loop over m ! Close history file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine med_phases_history_write_lnd2glc @@ -752,18 +758,18 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, instfile%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(instfile%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(instfile%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(instfile%io_file) + call med_io_write_time(instfile%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -771,19 +777,19 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ny = is_local%wrap%ny(compid) ! Define/write import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/write import export bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/Write mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & nt=1, pre='Med_frac_'//trim(compname(compid)), tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -791,7 +797,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(instfile%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -957,18 +963,18 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, rc, clobber=.true.) + call med_io_wopen(hist_file, avgfile%io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(avgfile%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(avgfile%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(avgfile%io_file) + call med_io_write_time(avgfile%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -977,7 +983,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & + call med_io_write(avgfile%io_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then @@ -986,7 +992,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end if endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & + call med_io_write(avgfile%io_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then @@ -998,7 +1004,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(avgfile%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of write_now if-block @@ -1281,40 +1287,40 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(auxcomp%files(nf)%histfile, vm, rc, file_ind=nf, clobber=.true.) + call med_io_wopen(auxcomp%files(nf)%histfile, auxcomp%files(nf)%io_file, vm, rc, file_ind=nf, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, file_ind=nf, rc=rc) + call med_io_define_time(auxcomp%files(nf)%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define data variables with a time dimension (include the nt argument below) - call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), & + call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), & whead(1), wdata(1), nx, ny, nt=auxcomp%files(nf)%nt, & pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & - file_ind=nf, use_float=.true., rc=rc) + use_float=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end definition phase - call med_io_enddef(auxcomp%files(nf)%histfile, file_ind=nf) + call med_io_enddef(auxcomp%files(nf)%io_file) end if ! Write time variables for time nt - call med_io_write_time(time_val, time_bnds, nt=auxcomp%files(nf)%nt, file_ind=nf, rc=rc) + call med_io_write_time(auxcomp%files(nf)%io_file, time_val, time_bnds, nt=auxcomp%files(nf)%nt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data variables for time nt if (auxcomp%files(nf)%doavg) then - call med_io_write(auxcomp%files(nf)%histfile, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + call med_io_write(auxcomp%files(nf)%io_file, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nf)%FBaccum, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1322,7 +1328,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) if (auxcomp%files(nf)%nt == auxcomp%files(nf)%ntperfile) then call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_close(auxcomp%files(nf)%histfile, vm, file_ind=nf, rc=rc) + call med_io_close(auxcomp%files(nf)%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxcomp%files(nf)%nt = 0 end if diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 3b276b08e..a225ff97c 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -13,7 +13,7 @@ module med_phases_restart_mod use med_phases_prep_glc_mod , only : FBlndAccum2glc_l, lndAccum2glc_cnt use med_phases_prep_glc_mod , only : FBocnAccum2glc_o, ocnAccum2glc_cnt use med_phases_prep_rof_mod , only : FBlndAccum2rof_l, lndAccum2rof_cnt - + use pio , only : file_desc_t implicit none private @@ -143,6 +143,7 @@ subroutine med_phases_restart_write(gcomp, rc) integer, intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_Time) :: starttime @@ -309,12 +310,12 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(restart_file, vm, rc, clobber=.true.) + call med_io_wopen(restart_file, io_file, vm, rc, clobber=.true.) if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 if (m == 2) then - call med_io_enddef(restart_file) + call med_io_enddef(io_file) end if tbnds = days_since @@ -322,23 +323,23 @@ subroutine med_phases_restart_write(gcomp, rc) if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) + call med_io_write_time(io_file, days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write out next ymd/tod in place of curr ymd/tod because the ! restart represents the time at end of the current timestep ! and that is where we want to start the next run. - call med_io_write(restart_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) + call med_io_write(io_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) + call med_io_write(io_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps @@ -347,19 +348,19 @@ subroutine med_phases_restart_write(gcomp, rc) ny = is_local%wrap%ny(n) ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Frac', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -370,10 +371,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumOcn)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & nt=1, pre='ocnExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -381,10 +382,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumWav)) then nx = is_local%wrap%nx(compwav) ny = is_local%wrap%ny(compwav) - call med_io_write(restart_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & nt=1, pre='wavExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -392,10 +393,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & nt=1, pre='lndImpAccum2rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -403,10 +404,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & nt=1, pre='lndImpAccum2glc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -414,10 +415,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBocnAccum2glc_o)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & nt=1, pre='ocnImpAccum2glc_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -425,7 +426,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & nt=1, pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -438,11 +439,11 @@ subroutine med_phases_restart_write(gcomp, rc) if (auxcomp(nc)%files(nf)%doavg .and. auxcomp(nc)%files(nf)%accumcnt > 0) then nx = is_local%wrap%nx(nc) ny = is_local%wrap%ny(nc) - call med_io_write(restart_file, auxcomp(nc)%files(nf)%FBaccum, & + call med_io_write(io_file, auxcomp(nc)%files(nf)%FBaccum, & whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, auxcomp(nc)%files(nf)%accumcnt, & + call med_io_write(io_file, auxcomp(nc)%files(nf)%accumcnt, & trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname)//'_accumcnt', & whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -453,7 +454,7 @@ subroutine med_phases_restart_write(gcomp, rc) enddo ! end of whead/wdata loop ! Close file - call med_io_close(restart_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif From 4490cffdc06f2664022c621034cbd24222ef535d Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 10:25:37 -0600 Subject: [PATCH 06/10] ntperfile should be type integer --- cime_config/namelist_definition_drv.xml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index 5cbf78319..f6e1d4442 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1347,7 +1347,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1414,7 +1414,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1483,7 +1483,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1548,7 +1548,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -1766,7 +1766,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. @@ -2011,7 +2011,7 @@ - char + integer aux_hist MED_attributes Number of time samples per file. From 57e1970552fb68d88d7cdf4e3a84d511bd03f006 Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Thu, 11 May 2023 11:27:08 -0600 Subject: [PATCH 07/10] remove unused variable --- mediator/med_io_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 9215777c0..3a8fb2d6f 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -616,7 +616,6 @@ subroutine med_io_close(io_file, rc) ! local variables - integer :: iam character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- From b60c9d7f6089de5ecb2e6784a21c84f6906a6d75 Mon Sep 17 00:00:00 2001 From: kdraeder Date: Thu, 11 May 2023 13:58:56 -0600 Subject: [PATCH 08/10] Candidate fixes of descriptions and comments --- cime_config/namelist_definition_drv.xml | 44 ++++++++++++------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index f6e1d4442..bfe991383 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -1235,7 +1235,7 @@ - + logical aux_hist @@ -1267,7 +1267,7 @@ integer aux_hist MED_attributes - history option type + history option span 1 @@ -1300,7 +1300,7 @@ - + logical aux_hist @@ -1332,7 +1332,7 @@ integer aux_hist MED_attributes - history option type + history option span 1 @@ -1365,7 +1365,7 @@ - + logical aux_hist @@ -1381,7 +1381,7 @@ char aux_hist MED_attributes - Auxiliary mediator atm2med precipitation history output every 3 hours + Auxiliary mediator atm2med precipitation fields history output every 3 hours Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl @@ -1399,7 +1399,7 @@ integer aux_hist MED_attributes - history option type + history option span 3 @@ -1432,13 +1432,13 @@ - + logical aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x dynamic, radiation, and precipitation history output every 3 hours .false. @@ -1449,7 +1449,7 @@ aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x dynamic, radiation, and precipitation fields history output every 3 hours Sa_z:Sa_topo:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Sa_co2diag:Sa_co2prog @@ -1468,7 +1468,7 @@ integer aux_hist MED_attributes - history option type + history option span 3 @@ -1501,12 +1501,12 @@ - + logical aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x aerosol and ghg history output daily or endofrun .false. @@ -1515,7 +1515,7 @@ char aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x aerosol and ghg history output daily or endofrun Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag @@ -1533,9 +1533,9 @@ integer aux_hist MED_attributes - history option type + history option span - 1 + 3 @@ -1553,7 +1553,7 @@ MED_attributes Number of time samples per file. - 1 + 2 @@ -1801,7 +1801,7 @@ - + logical aux_hist @@ -1978,7 +1978,7 @@ char aux_hist MED_attributes - Auxiliary mediator rof2med precipitation history output. + Auxiliary mediator rof2med precipitation fields history output. all @@ -1996,9 +1996,9 @@ integer aux_hist MED_attributes - history option type + history option span - 6 + 3 @@ -2016,7 +2016,7 @@ MED_attributes Number of time samples per file. - 1 + 2 From 42a5fd537fd166eea08a8a132cc159c25a471ec6 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 11 May 2023 15:39:03 -0600 Subject: [PATCH 09/10] remove dead code --- mediator/med_io_mod.F90 | 17 ----------------- 1 file changed, 17 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 3a8fb2d6f..d55ebc724 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -75,10 +75,6 @@ module med_io_mod character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" - integer , parameter :: number_strlen = 8 - integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - -! character(CL) :: wfilename(0:file_desc_t_cnt) = '' integer :: pio_iotype integer :: pio_ioformat @@ -546,9 +542,6 @@ subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_ if (.not. pio_file_is_open(io_file)) then - ! filename not open -! wfilename(lfile_ind) = trim(filename) - if (med_io_file_exists(vm, filename)) then if (lclobber) then nmode = pio_clobber @@ -585,16 +578,6 @@ subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_ rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) endif -! elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then - ! filename is open, better match open filename -! if (iam==0) then -! write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) -! write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) -! end if -! call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_ERROR) -! rc = ESMF_FAILURE -! return - else ! filename is already open, just return endif From 96206b6366dca33da7fe20021c71a5f0db8ace7a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Fri, 12 May 2023 08:54:52 -0600 Subject: [PATCH 10/10] adjust indentation --- mediator/med_phases_history_mod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index e647dc647..5f150a4b7 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -60,7 +60,7 @@ module med_phases_history_mod ! Instantaneous history files datatypes/variables per component ! ---------------------------- type, public :: instfile_type - type(file_desc_t) :: io_file + type(file_desc_t):: io_file logical :: write_inst character(CS) :: hist_option integer :: hist_n @@ -76,7 +76,7 @@ module med_phases_history_mod ! Time averaging history files ! ---------------------------- type, public :: avgfile_type - type(file_desc_t) :: io_file + type(file_desc_t) :: io_file logical :: write_avg type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging integer :: accumcnt_import ! field bundle accumulation counter @@ -96,7 +96,7 @@ module med_phases_history_mod ! Auxiliary history files ! ---------------------------- type, public :: auxfile_type - type(file_desc_t) :: io_file + type(file_desc_t) :: io_file character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name