Skip to content

Commit

Permalink
fix issues in refactor
Browse files Browse the repository at this point in the history
  • Loading branch information
jedwards4b committed Sep 4, 2024
1 parent 5020df6 commit 9d057d7
Showing 1 changed file with 73 additions and 73 deletions.
146 changes: 73 additions & 73 deletions dglc/dglc_datamode_noevolve_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -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

!===============================================================================
Expand Down Expand Up @@ -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
Expand All @@ -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

Expand Down

0 comments on commit 9d057d7

Please sign in to comment.