Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Fix aux history files for use_float=.true. #488

Merged
merged 8 commits into from
Aug 1, 2024
Merged

Fix aux history files for use_float=.true. #488

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
95137f4
fix use_float=.true. for aux history files
DeniseWorthen Jun 24, 2024
dc501e9
fix indenting
DeniseWorthen Jun 24, 2024
3fcfa97
Merge remote-tracking branch 'ESCOMP/main' into feature/fixfloat4auxhist
DeniseWorthen Jun 27, 2024
2bb653d
aux history (float) should not use ntiles
DeniseWorthen Jun 27, 2024
f62eff7
Merge remote-tracking branch 'ESCOMP/main' into feature/fixfloat4auxhist
DeniseWorthen Jul 24, 2024
8a30f50
fixes from testing for ATM auxhist output
DeniseWorthen Jul 25, 2024
674f026
Merge remote-tracking branch 'ESCOMP/main' into HEAD
DeniseWorthen Jul 26, 2024
882d485
fix garbled print statement for scalars
DeniseWorthen Jul 26, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 3 additions & 4 deletions mediator/med.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2154,14 +2154,13 @@ subroutine DataInitialize(gcomp, rc)
end if
is_local%wrap%nx(n1) = nint(real_nx)
is_local%wrap%ny(n1) = nint(real_ny)
endif
if (is_local%wrap%comp_present(n1)) then

write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1)
call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO)
if (maintask) then
write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString)
end if
call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO)
endif
end if
end do
if (maintask) write(logunit,*)

Expand Down
89 changes: 60 additions & 29 deletions mediator/med_io_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -870,24 +870,28 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &

ng = maxval(maxIndexPTile)
if (tiles) then
lnx = nx
lny = ny
lntile = ng/(lnx*lny)
write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
if (lntile /= ntile) then
call ESMF_LogWrite(trim(subname)//' ERROR: grid2d size and ntile are not consistent ', ESMF_LOGMSG_INFO)
call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
lnx = ng
lny = 1
lntile = 1
if (nx > 0) lnx = nx
if (ny > 0) lny = ny
if (ntile > 0) lntile = ntile
write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
if (lnx*lny*lntile /= ng) then
write(tmpstr,*) subname,' ERROR: grid size not consistent ',ng,lnx,lny,lntile
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
call ESMF_Finalize(endflag=ESMF_END_ABORT)
end if
else
lnx = ng
lny = 1
if (nx > 0) lnx = nx
if (ny > 0) lny = ny
if (lnx*lny /= ng) then
write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
endif
lnx = ng
lny = 1
if (nx > 0) lnx = nx
if (ny > 0) lny = ny
if (lnx*lny /= ng) then
write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
endif
end if
deallocate(minIndexPTile, maxIndexPTile)

Expand All @@ -902,7 +906,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
if (tiles) then
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)//'_ntile', ntile, dimid3(3))
rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', lntile, dimid3(3))
if (present(nt)) then
dimid4(1:3) = dimid3
rcode = pio_inq_dimid(io_file, 'time', dimid4(4))
Expand Down Expand Up @@ -1020,10 +1024,18 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof)
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
if (tiles) then
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntile/), dof, iodesc)
if (luse_float) then
call pio_initdecomp(io_subsystem, pio_real, (/lnx,lny,lntile/), dof, iodesc)
else
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,lntile/), dof, iodesc)
end if
else
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc)
!call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom)
if (luse_float) then
call pio_initdecomp(io_subsystem, pio_real, (/lnx,lny/), dof, iodesc)
else
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc)
end if
!call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom)
end if
deallocate(dof)

Expand Down Expand Up @@ -1056,10 +1068,18 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
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, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue)
else if (gridToFieldMap(1) == 2) then
call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue)
if (luse_float) then
if (gridToFieldMap(1) == 1) then
call pio_write_darray(io_file, varid, iodesc, real(fldptr2(:,n),r4), rcode, fillval=real(lfillvalue,r4))
else if (gridToFieldMap(1) == 2) then
call pio_write_darray(io_file, varid, iodesc, real(fldptr2(n,:),r4), rcode, fillval=real(lfillvalue,r4))
end if
else
if (gridToFieldMap(1) == 1) then
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, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue)
end if
end if
end do
else if (rank == 1 .or. rank == 0) then
Expand All @@ -1068,7 +1088,11 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
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, varid, iodesc, fldptr1, rcode, fillval=lfillvalue)
if (luse_float) then
call pio_write_darray(io_file, varid, iodesc, real(fldptr1,r4), rcode, fillval=real(lfillvalue,r4))
else
call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue)
end if
end if ! end if rank is 2 or 1 or 0

end if ! end if not "hgt"
Expand All @@ -1077,12 +1101,19 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
! Fill coordinate variables - why is this being done each time?
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)
if (luse_float) then
call pio_write_darray(io_file, varid, iodesc, real(ownedElemCoords_x,r4), rcode, fillval=real(lfillvalue,r4))
else
call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue)
end if

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)

if (luse_float) then
call pio_write_darray(io_file, varid, iodesc, real(ownedElemCoords_y,r4), rcode, fillval=real(lfillvalue,r4))
else
call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue)
end if
call pio_syncfile(io_file)
call pio_freedecomp(io_file, iodesc)
endif
Expand Down
22 changes: 15 additions & 7 deletions mediator/med_phases_history_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -357,11 +357,13 @@ subroutine med_phases_history_write(gcomp, rc)
end if
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then
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)
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', &
ntile=is_local%wrap%ntile(compatm), rc=rc)
end if
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then
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)
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', &
ntile=is_local%wrap%ntile(compatm), rc=rc)
end if

end do ! end of loop over whead/wdata m index phases
Expand Down Expand Up @@ -495,7 +497,8 @@ subroutine med_phases_history_write_med(gcomp, rc)
end if
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then
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)
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', &
ntile=is_local%wrap%ntile(compatm), rc=rc)
end if

! If appropriate - write ocn albedos computed in mediator
Expand All @@ -505,7 +508,8 @@ subroutine med_phases_history_write_med(gcomp, rc)
end if
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then
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)
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', &
ntile=is_local%wrap%ntile(compatm), rc=rc)
end if
end do ! end of loop over m

Expand Down Expand Up @@ -1058,6 +1062,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc)
logical :: enable_auxfile
character(CL) :: time_units ! units of time variable
integer :: nx,ny ! global grid size
integer :: ntile ! number of tiles for tiled domain eg CSG
logical :: write_now ! if true, write time sample to file
real(r8) :: time_val ! time coordinate output
real(r8) :: time_bnds(2) ! time bounds output
Expand Down Expand Up @@ -1264,6 +1269,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc)
! Set shorthand variables
nx = is_local%wrap%nx(compid)
ny = is_local%wrap%ny(compid)
ntile = is_local%wrap%ntile(compid)

! Increment number of time samples on file
auxcomp%files(nf)%nt = auxcomp%files(nf)%nt + 1
Expand Down Expand Up @@ -1299,7 +1305,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc)
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, &
use_float=.true., rc=rc)
use_float=.true., ntile=ntile, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return

! end definition phase
Expand All @@ -1313,13 +1319,15 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc)
! Write data variables for time nt
if (auxcomp%files(nf)%doavg) then
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)
nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, &
use_float=.true., ntile=ntile, 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)%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)
nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, &
use_float=.true., ntile=ntile, rc=rc)
if (ChkErr(rc,__LINE__,u_FILE_u)) return
end if

Expand Down
Loading