Skip to content

Commit 72280dd

Browse files
jedwards4bjedwards4b
authored
Merge pull request #488 from DeniseWorthen/feature/fixfloat4auxhist
Fix aux history files for use_float=.true.
2 parents 4520051 + 882d485 commit 72280dd

File tree

3 files changed

+78
-40
lines changed

3 files changed

+78
-40
lines changed

‎mediator/med.F90

+3-4
Original file line numberDiff line numberDiff line change
@@ -2154,14 +2154,13 @@ subroutine DataInitialize(gcomp, rc)
21542154
end if
21552155
is_local%wrap%nx(n1) = nint(real_nx)
21562156
is_local%wrap%ny(n1) = nint(real_ny)
2157-
endif
2158-
if (is_local%wrap%comp_present(n1)) then
2157+
21592158
write(msgString,'(3i8)') is_local%wrap%nx(n1), is_local%wrap%ny(n1), is_local%wrap%ntile(n1)
2159+
call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO)
21602160
if (maintask) then
21612161
write(logunit,'(a)') 'global nx,ny,ntile sizes for '//trim(compname(n1))//":"//trim(msgString)
21622162
end if
2163-
call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO)
2164-
endif
2163+
end if
21652164
end do
21662165
if (maintask) write(logunit,*)
21672166

‎mediator/med_io_mod.F90

+60-29
Original file line numberDiff line numberDiff line change
@@ -870,24 +870,28 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
870870

871871
ng = maxval(maxIndexPTile)
872872
if (tiles) then
873-
lnx = nx
874-
lny = ny
875-
lntile = ng/(lnx*lny)
876-
write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile
877-
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
878-
if (lntile /= ntile) then
879-
call ESMF_LogWrite(trim(subname)//' ERROR: grid2d size and ntile are not consistent ', ESMF_LOGMSG_INFO)
880-
call ESMF_Finalize(endflag=ESMF_END_ABORT)
881-
endif
873+
lnx = ng
874+
lny = 1
875+
lntile = 1
876+
if (nx > 0) lnx = nx
877+
if (ny > 0) lny = ny
878+
if (ntile > 0) lntile = ntile
879+
write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile
880+
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
881+
if (lnx*lny*lntile /= ng) then
882+
write(tmpstr,*) subname,' ERROR: grid size not consistent ',ng,lnx,lny,lntile
883+
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
884+
call ESMF_Finalize(endflag=ESMF_END_ABORT)
885+
end if
882886
else
883-
lnx = ng
884-
lny = 1
885-
if (nx > 0) lnx = nx
886-
if (ny > 0) lny = ny
887-
if (lnx*lny /= ng) then
888-
write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny
889-
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
890-
endif
887+
lnx = ng
888+
lny = 1
889+
if (nx > 0) lnx = nx
890+
if (ny > 0) lny = ny
891+
if (lnx*lny /= ng) then
892+
write(tmpstr,*) subname,' WARNING: grid2d size not consistent ',ng,lnx,lny
893+
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
894+
endif
891895
end if
892896
deallocate(minIndexPTile, maxIndexPTile)
893897

@@ -902,7 +906,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
902906
if (tiles) then
903907
rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1))
904908
rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2))
905-
rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', ntile, dimid3(3))
909+
rcode = pio_def_dim(io_file, trim(lpre)//'_ntile', lntile, dimid3(3))
906910
if (present(nt)) then
907911
dimid4(1:3) = dimid3
908912
rcode = pio_inq_dimid(io_file, 'time', dimid4(4))
@@ -1020,10 +1024,18 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
10201024
write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof)
10211025
call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO)
10221026
if (tiles) then
1023-
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,ntile/), dof, iodesc)
1027+
if (luse_float) then
1028+
call pio_initdecomp(io_subsystem, pio_real, (/lnx,lny,lntile/), dof, iodesc)
1029+
else
1030+
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny,lntile/), dof, iodesc)
1031+
end if
10241032
else
1025-
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc)
1026-
!call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom)
1033+
if (luse_float) then
1034+
call pio_initdecomp(io_subsystem, pio_real, (/lnx,lny/), dof, iodesc)
1035+
else
1036+
call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc)
1037+
end if
1038+
!call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom)
10271039
end if
10281040
deallocate(dof)
10291041

@@ -1056,10 +1068,18 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
10561068
rcode = pio_inq_varid(io_file, trim(name1), varid)
10571069
call pio_setframe(io_file,varid,frame)
10581070

1059-
if (gridToFieldMap(1) == 1) then
1060-
call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue)
1061-
else if (gridToFieldMap(1) == 2) then
1062-
call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue)
1071+
if (luse_float) then
1072+
if (gridToFieldMap(1) == 1) then
1073+
call pio_write_darray(io_file, varid, iodesc, real(fldptr2(:,n),r4), rcode, fillval=real(lfillvalue,r4))
1074+
else if (gridToFieldMap(1) == 2) then
1075+
call pio_write_darray(io_file, varid, iodesc, real(fldptr2(n,:),r4), rcode, fillval=real(lfillvalue,r4))
1076+
end if
1077+
else
1078+
if (gridToFieldMap(1) == 1) then
1079+
call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue)
1080+
else if (gridToFieldMap(1) == 2) then
1081+
call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue)
1082+
end if
10631083
end if
10641084
end do
10651085
else if (rank == 1 .or. rank == 0) then
@@ -1068,7 +1088,11 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
10681088
call pio_setframe(io_file,varid,frame)
10691089
! fix for writing data on exchange grid, which has no data in some PETs
10701090
if (rank == 0) nullify(fldptr1)
1071-
call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue)
1091+
if (luse_float) then
1092+
call pio_write_darray(io_file, varid, iodesc, real(fldptr1,r4), rcode, fillval=real(lfillvalue,r4))
1093+
else
1094+
call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue)
1095+
end if
10721096
end if ! end if rank is 2 or 1 or 0
10731097

10741098
end if ! end if not "hgt"
@@ -1077,12 +1101,19 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, &
10771101
! Fill coordinate variables - why is this being done each time?
10781102
rcode = pio_inq_varid(io_file, trim(coordvarnames(1)), varid)
10791103
call pio_setframe(io_file,varid,frame)
1080-
call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue)
1104+
if (luse_float) then
1105+
call pio_write_darray(io_file, varid, iodesc, real(ownedElemCoords_x,r4), rcode, fillval=real(lfillvalue,r4))
1106+
else
1107+
call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue)
1108+
end if
10811109

10821110
rcode = pio_inq_varid(io_file, trim(coordvarnames(2)), varid)
10831111
call pio_setframe(io_file,varid,frame)
1084-
call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue)
1085-
1112+
if (luse_float) then
1113+
call pio_write_darray(io_file, varid, iodesc, real(ownedElemCoords_y,r4), rcode, fillval=real(lfillvalue,r4))
1114+
else
1115+
call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue)
1116+
end if
10861117
call pio_syncfile(io_file)
10871118
call pio_freedecomp(io_file, iodesc)
10881119
endif

‎mediator/med_phases_history_mod.F90

+15-7
Original file line numberDiff line numberDiff line change
@@ -357,11 +357,13 @@ subroutine med_phases_history_write(gcomp, rc)
357357
end if
358358
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then
359359
call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), &
360-
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc)
360+
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', &
361+
ntile=is_local%wrap%ntile(compatm), rc=rc)
361362
end if
362363
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then
363364
call med_io_write(io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), &
364-
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc)
365+
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', &
366+
ntile=is_local%wrap%ntile(compatm), rc=rc)
365367
end if
366368

367369
end do ! end of loop over whead/wdata m index phases
@@ -495,7 +497,8 @@ subroutine med_phases_history_write_med(gcomp, rc)
495497
end if
496498
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then
497499
call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), &
498-
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc)
500+
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', &
501+
ntile=is_local%wrap%ntile(compatm), rc=rc)
499502
end if
500503

501504
! If appropriate - write ocn albedos computed in mediator
@@ -505,7 +508,8 @@ subroutine med_phases_history_write_med(gcomp, rc)
505508
end if
506509
if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then
507510
call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), &
508-
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc)
511+
is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', &
512+
ntile=is_local%wrap%ntile(compatm), rc=rc)
509513
end if
510514
end do ! end of loop over m
511515

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

12681274
! Increment number of time samples on file
12691275
auxcomp%files(nf)%nt = auxcomp%files(nf)%nt + 1
@@ -1299,7 +1305,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc)
12991305
call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), &
13001306
whead(1), wdata(1), nx, ny, nt=auxcomp%files(nf)%nt, &
13011307
pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, &
1302-
use_float=.true., rc=rc)
1308+
use_float=.true., ntile=ntile, rc=rc)
13031309
if (ChkErr(rc,__LINE__,u_FILE_u)) return
13041310

13051311
! end definition phase
@@ -1313,13 +1319,15 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc)
13131319
! Write data variables for time nt
13141320
if (auxcomp%files(nf)%doavg) then
13151321
call med_io_write(auxcomp%files(nf)%io_file, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, &
1316-
nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc)
1322+
nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, &
1323+
use_float=.true., ntile=ntile, rc=rc)
13171324
if (ChkErr(rc,__LINE__,u_FILE_u)) return
13181325
call med_methods_FB_reset(auxcomp%files(nf)%FBaccum, value=czero, rc=rc)
13191326
if (ChkErr(rc,__LINE__,u_FILE_u)) return
13201327
else
13211328
call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, &
1322-
nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc)
1329+
nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, &
1330+
use_float=.true., ntile=ntile, rc=rc)
13231331
if (ChkErr(rc,__LINE__,u_FILE_u)) return
13241332
end if
13251333

0 commit comments

Comments
 (0)