Skip to content

Commit

Permalink
Merge pull request #488 from DeniseWorthen/feature/fixfloat4auxhist
Browse files Browse the repository at this point in the history 
Fix aux history files for use_float=.true.
  • Loading branch information
@jedwards4b
jedwards4b authored Aug 1, 2024
2 parents 4520051 + 882d485 commit 72280dd
Show file tree
Hide file tree
Showing 3 changed files with 78 additions and 40 deletions.
7 changes: 3 additions & 4 deletions mediator/med.F90
View file
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
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
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

0 comments on commit 72280dd

Please sign in to comment.