From 9d057d7878a75cc48aa0fe77e642543fa615330f Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Tue, 3 Sep 2024 21:45:48 -0600 Subject: [PATCH 1/3] fix issues in refactor --- dglc/dglc_datamode_noevolve_mod.F90 | 146 ++++++++++++++-------------- 1 file changed, 73 insertions(+), 73 deletions(-) diff --git a/dglc/dglc_datamode_noevolve_mod.F90 b/dglc/dglc_datamode_noevolve_mod.F90 index 0c5dd8bd..75d3b466 100644 --- a/dglc/dglc_datamode_noevolve_mod.F90 +++ b/dglc/dglc_datamode_noevolve_mod.F90 @@ -469,49 +469,51 @@ subroutine dglc_datamode_noevolve_restart_write(model_meshes, case_name, & !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - + call shr_cal_datetod2string(date_str, ymd, tod) + write(rest_file_model ,"(7a)") trim(case_name),'.','dglc',trim(inst_suffix),'.r.',trim(date_str),'.nc' + ! write restart info to rpointer file + if (my_task == main_task) then + open(newunit=nu, file=trim(rpfile)//trim(inst_suffix), form='formatted') + write(nu,'(a)') rest_file_model + close(nu) + write(logunit,'(a,2x,i0,2x,i0)')' writing with no streams '//trim(rest_file_model), ymd, tod + endif + + ! write data model restart data + rcode = pio_createfile(pio_subsystem, pioid, io_type, trim(rest_file_model), pio_clobber) + do ns = 1,num_icesheets - ! Determine gindex for this ice sheet - call ESMF_MeshGet(model_meshes(ns), elementdistGrid=distGrid, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distGrid, localDe=0, elementCount=lsize, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(gindex(lsize)) - call ESMF_DistGridGet(distGrid, localDe=0, seqIndexList=gindex, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Need to explicitly write restart since noevolve mode does not read a stream write(cnum,'(i0)') ns - call shr_cal_datetod2string(date_str, ymd, tod) - write(rest_file_model ,"(7a)") trim(case_name),'.','dglc',trim(inst_suffix),'.r.',trim(date_str),'.nc' - - ! write restart info to rpointer file - if (my_task == main_task) then - open(newunit=nu, file=trim(rpfile)//trim(inst_suffix), form='formatted') - write(nu,'(a)') rest_file_model - close(nu) - write(logunit,'(a,2x,i0,2x,i0)')' writing with no streams '//trim(rest_file_model), ymd, tod - endif - - ! write data model restart data - rcode = pio_createfile(pio_subsystem, pioid, io_type, trim(rest_file_model), pio_clobber) rcode = pio_def_dim(pioid, '_nx'//trim(cnum), nx_global(ns), dimid2(1)) rcode = pio_def_dim(pioid, '_ny'//trim(cnum), ny_global(ns), dimid2(2)) rcode = pio_def_var(pioid, 'flgl_rofi'//cnum, PIO_DOUBLE, (/dimid2/), varid) rcode = pio_put_att(pioid, varid, "_FillValue", shr_const_spval) rcode = pio_set_fill(pioid, PIO_FILL, oldmode) rcode = pio_put_att(pioid, pio_global, "version", "nuopc_data_models_v0") - rcode = pio_enddef(pioid) + enddo + rcode = pio_enddef(pioid) + do ns = 1,num_icesheets + + ! Determine gindex for this ice sheet + call ESMF_MeshGet(model_meshes(ns), elementdistGrid=distGrid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_DistGridGet(distGrid, localDe=0, elementCount=lsize, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(gindex(lsize)) + call ESMF_DistGridGet(distGrid, localDe=0, seqIndexList=gindex, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call pio_initdecomp(pio_subsystem, pio_double, (/nx_global(ns),ny_global(ns)/), gindex, pio_iodesc) call pio_write_darray(pioid, varid, pio_iodesc, Fgrg_rofi(ns)%ptr, rcode, fillval=shr_const_spval) - call pio_closefile(pioid) call pio_freedecomp(pio_subsystem, pio_iodesc) ! Deallocate gindex deallocate (gindex) end do + call pio_closefile(pioid) end subroutine dglc_datamode_noevolve_restart_write !=============================================================================== @@ -551,7 +553,48 @@ subroutine dglc_datamode_noevolve_restart_read(model_meshes, restfilem, & !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + ! Determine restart file + + if (trim(restfilem) == trim(nullstr)) then + exists = .false. + call ESMF_VMGetCurrent(vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == main_task) then + write(logunit,'(a)') trim(subname)//' restart filename from rpointer' + inquire(file=trim(rpfile)//trim(inst_suffix), exist=exists) + if (.not.exists) then + write(logunit, '(a)') trim(subname)//' ERROR: rpointer file does not exist' + call shr_sys_abort(trim(subname)//' ERROR: rpointer file missing') + endif + open(newunit=nu, file=trim(rpfile)//trim(inst_suffix), form='formatted') + read(nu,'(a)') restfilem + close(nu) + inquire(file=trim(restfilem), exist=exists) + endif + call ESMF_VMBroadCast(vm, restfilem, CL, main_task, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + ! use namelist already read + if (my_task == main_task) then + write(logunit, '(a)') trim(subname)//' restart filenames from namelist ' + inquire(file=trim(restfilem), exist=exists) + endif + endif + tmp = 0 + if(exists) tmp=1 + exists = (tmp(1) == 1) + if (.not. exists .and. my_task == main_task) then + write(logunit, '(a)') trim(subname)//' file not found, skipping '//trim(restfilem) + return + end if + + ! Read restart file + if (my_task == main_task) then + write(logunit, '(a)') trim(subname)//' reading data model restart '//trim(restfilem) + end if + + rcode = pio_openfile(pio_subsystem, pioid, io_type, trim(restfilem), pio_nowrite) do ns = 1,num_icesheets write(cnum,'(i0)') ns @@ -565,60 +608,17 @@ subroutine dglc_datamode_noevolve_restart_read(model_meshes, restfilem, & call ESMF_DistGridGet(distGrid, localDe=0, seqIndexList=gindex, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGetCurrent(vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Determine restart file - exists = .false. - if (trim(restfilem) == trim(nullstr)) then - if (my_task == main_task) then - write(logunit,'(a)') trim(subname)//' restart filename from rpointer' - inquire(file=trim(rpfile)//trim(inst_suffix), exist=exists) - if (.not.exists) then - write(logunit, '(a)') trim(subname)//' ERROR: rpointer file does not exist' - call shr_sys_abort(trim(subname)//' ERROR: rpointer file missing') - endif - open(newunit=nu, file=trim(rpfile)//trim(inst_suffix), form='formatted') - read(nu,'(a)') restfilem - close(nu) - inquire(file=trim(restfilem), exist=exists) - endif - call ESMF_VMBroadCast(vm, restfilem, CL, main_task, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - ! use namelist already read - if (my_task == main_task) then - write(logunit, '(a)') trim(subname)//' restart filenames from namelist ' - inquire(file=trim(restfilem), exist=exists) - endif - endif - tmp = 0 - if(exists) tmp=1 - call ESMF_VMBroadCast(vm, tmp, 1, main_task, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - exists = (tmp(1) == 1) - - ! Read restart file - if (exists) then - if (my_task == main_task) then - write(logunit, '(a)') trim(subname)//' reading data model restart '//trim(restfilem) - end if - rcode = pio_openfile(pio_subsystem, pioid, io_type, trim(restfilem), pio_nowrite) - call pio_initdecomp(pio_subsystem, pio_double, (/nx_global(ns),ny_global(ns)/), gindex, pio_iodesc) - rcode = pio_inq_varid(pioid, 'flgl_rofi'//cnum, varid) - call pio_read_darray(pioid, varid, pio_iodesc, Fgrg_rofi(ns)%ptr, rcode) - call pio_closefile(pioid) - call pio_freedecomp(pio_subsystem, pio_iodesc) - else - if (my_task == main_task) then - write(logunit, '(a)') trim(subname)//' file not found, skipping '//trim(restfilem) - end if - endif + call pio_initdecomp(pio_subsystem, pio_double, (/nx_global(ns),ny_global(ns)/), gindex, pio_iodesc) + rcode = pio_inq_varid(pioid, 'flgl_rofi'//cnum, varid) + call pio_read_darray(pioid, varid, pio_iodesc, Fgrg_rofi(ns)%ptr, rcode) + call pio_freedecomp(pio_subsystem, pio_iodesc) ! Deallocate gindex deallocate(gindex) end do ! loop over ice sheets + call pio_closefile(pioid) end subroutine dglc_datamode_noevolve_restart_read From e982ef215b10159256bcbbcc6c93cdaafdab191a Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Sep 2024 06:57:57 -0600 Subject: [PATCH 2/3] fix varid in write --- dglc/dglc_datamode_noevolve_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/dglc/dglc_datamode_noevolve_mod.F90 b/dglc/dglc_datamode_noevolve_mod.F90 index 75d3b466..c083a911 100644 --- a/dglc/dglc_datamode_noevolve_mod.F90 +++ b/dglc/dglc_datamode_noevolve_mod.F90 @@ -462,7 +462,7 @@ subroutine dglc_datamode_noevolve_restart_write(model_meshes, case_name, & character(len=CS) :: date_str type(file_desc_t) :: pioid integer :: dimid2(2) - type(var_desc_t) :: varid + type(var_desc_t), allocatable :: varid(:) type(io_desc_t) :: pio_iodesc integer :: oldmode integer :: rcode @@ -481,15 +481,15 @@ subroutine dglc_datamode_noevolve_restart_write(model_meshes, case_name, & ! write data model restart data rcode = pio_createfile(pio_subsystem, pioid, io_type, trim(rest_file_model), pio_clobber) - + allocate(varid(num_icesheets)) do ns = 1,num_icesheets ! Need to explicitly write restart since noevolve mode does not read a stream write(cnum,'(i0)') ns rcode = pio_def_dim(pioid, '_nx'//trim(cnum), nx_global(ns), dimid2(1)) rcode = pio_def_dim(pioid, '_ny'//trim(cnum), ny_global(ns), dimid2(2)) - rcode = pio_def_var(pioid, 'flgl_rofi'//cnum, PIO_DOUBLE, (/dimid2/), varid) - rcode = pio_put_att(pioid, varid, "_FillValue", shr_const_spval) + rcode = pio_def_var(pioid, 'flgl_rofi'//cnum, PIO_DOUBLE, (/dimid2/), varid(ns)) + rcode = pio_put_att(pioid, varid(ns), "_FillValue", shr_const_spval) rcode = pio_set_fill(pioid, PIO_FILL, oldmode) rcode = pio_put_att(pioid, pio_global, "version", "nuopc_data_models_v0") enddo @@ -507,7 +507,7 @@ subroutine dglc_datamode_noevolve_restart_write(model_meshes, case_name, & if (ChkErr(rc,__LINE__,u_FILE_u)) return call pio_initdecomp(pio_subsystem, pio_double, (/nx_global(ns),ny_global(ns)/), gindex, pio_iodesc) - call pio_write_darray(pioid, varid, pio_iodesc, Fgrg_rofi(ns)%ptr, rcode, fillval=shr_const_spval) + call pio_write_darray(pioid, varid(ns), pio_iodesc, Fgrg_rofi(ns)%ptr, rcode, fillval=shr_const_spval) call pio_freedecomp(pio_subsystem, pio_iodesc) ! Deallocate gindex From 276e2a1617d1867087e85f6429522beba05be44d Mon Sep 17 00:00:00 2001 From: Jim Edwards Date: Wed, 4 Sep 2024 07:36:53 -0600 Subject: [PATCH 3/3] reorder iodesc destroy --- dglc/dglc_datamode_noevolve_mod.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/dglc/dglc_datamode_noevolve_mod.F90 b/dglc/dglc_datamode_noevolve_mod.F90 index c083a911..3393ea21 100644 --- a/dglc/dglc_datamode_noevolve_mod.F90 +++ b/dglc/dglc_datamode_noevolve_mod.F90 @@ -463,7 +463,7 @@ subroutine dglc_datamode_noevolve_restart_write(model_meshes, case_name, & type(file_desc_t) :: pioid integer :: dimid2(2) type(var_desc_t), allocatable :: varid(:) - type(io_desc_t) :: pio_iodesc + type(io_desc_t), allocatable :: pio_iodesc(:) integer :: oldmode integer :: rcode !------------------------------------------------------------------------------- @@ -494,7 +494,7 @@ subroutine dglc_datamode_noevolve_restart_write(model_meshes, case_name, & rcode = pio_put_att(pioid, pio_global, "version", "nuopc_data_models_v0") enddo rcode = pio_enddef(pioid) - + allocate(pio_iodesc(num_icesheets)) do ns = 1,num_icesheets ! Determine gindex for this ice sheet @@ -505,16 +505,18 @@ subroutine dglc_datamode_noevolve_restart_write(model_meshes, case_name, & allocate(gindex(lsize)) call ESMF_DistGridGet(distGrid, localDe=0, seqIndexList=gindex, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call pio_initdecomp(pio_subsystem, pio_double, (/nx_global(ns),ny_global(ns)/), gindex, pio_iodesc(ns)) + call pio_write_darray(pioid, varid(ns), pio_iodesc(ns), Fgrg_rofi(ns)%ptr, rcode, fillval=shr_const_spval) - call pio_initdecomp(pio_subsystem, pio_double, (/nx_global(ns),ny_global(ns)/), gindex, pio_iodesc) - call pio_write_darray(pioid, varid(ns), pio_iodesc, Fgrg_rofi(ns)%ptr, rcode, fillval=shr_const_spval) - call pio_freedecomp(pio_subsystem, pio_iodesc) - ! Deallocate gindex deallocate (gindex) end do call pio_closefile(pioid) - end subroutine dglc_datamode_noevolve_restart_write + do ns = 1,num_icesheets + call pio_freedecomp(pio_subsystem, pio_iodesc(ns)) + enddo + + end subroutine dglc_datamode_noevolve_restart_write !=============================================================================== subroutine dglc_datamode_noevolve_restart_read(model_meshes, restfilem, &