From 95137f44e8f37ee7a54091f511f1d8ef3a3b5252 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 24 Jun 2024 10:32:03 -0400 Subject: [PATCH 1/5] fix use_float=.true. for aux history files --- mediator/med_io_mod.F90 | 31 +++++++++++++++++++++++++++-- mediator/med_phases_history_mod.F90 | 18 +++++++++++------ 2 files changed, 41 insertions(+), 8 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index f4abadaf..5ff625b9 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1020,9 +1020,17 @@ 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 + 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) @@ -1056,10 +1064,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 (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 @@ -1068,7 +1084,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) + 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" @@ -1077,12 +1097,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) + 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) + 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 diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 0a6a7775..f485ae13 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -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 @@ -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 @@ -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 @@ -1313,13 +1317,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.,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.,rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if From dc501e96d7123f604f84cbe6e6c61dc8e8cfb13c Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 24 Jun 2024 10:38:06 -0400 Subject: [PATCH 2/5] fix indenting --- mediator/med_io_mod.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 5ff625b9..e9648f90 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1029,9 +1029,9 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & 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) + 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) + !call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) end if deallocate(dof) @@ -1065,16 +1065,16 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & call pio_setframe(io_file,varid,frame) if (luse_float) then - if (gridToFieldMap(1) == 1) 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) + 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 @@ -1087,7 +1087,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & 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) + 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 @@ -1100,7 +1100,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & 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) + 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) @@ -1108,7 +1108,7 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & 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) + 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) From 2bb653da9ceddef07331b92b7af381bafed2e7b2 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 27 Jun 2024 14:13:05 -0600 Subject: [PATCH 3/5] aux history (float) should not use ntiles --- mediator/med_io_mod.F90 | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index e9648f90..30768a64 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -870,15 +870,21 @@ 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 + if (luse_float) then + lnx = ntile*ny*nx + lny = 1 + lntile = 1 + else + 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 + end if else lnx = ng lny = 1 @@ -902,7 +908,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)) From 8a30f5083e4cec3747b328497e766e477badcd28 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 25 Jul 2024 06:41:22 -0600 Subject: [PATCH 4/5] fixes from testing for ATM auxhist output --- mediator/med_io_mod.F90 | 40 ++++++++++++++--------------- mediator/med_phases_history_mod.F90 | 8 +++--- 2 files changed, 24 insertions(+), 24 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 9a1185ef..1b89f463 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -870,30 +870,28 @@ subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & ng = maxval(maxIndexPTile) if (tiles) then - if (luse_float) then - lnx = ntile*ny*nx - lny = 1 - lntile = 1 - else - lnx = nx - lny = ny - lntile = ng/(lnx*lny) - write(tmpstr,*) subname, 'ng,lnx,lny,lntile = ',ng,lnx,lny,lntile + 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) - 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 + 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) diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index f485ae13..c895d6c4 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -1062,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 @@ -1268,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 @@ -1303,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 @@ -1318,14 +1320,14 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) 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, & - use_float=.true.,rc=rc) + 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, & - use_float=.true.,rc=rc) + use_float=.true., ntile=ntile, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if From 882d4850238b2c9b1ce81602fc68f9744a29df9d Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 26 Jul 2024 08:26:01 -0400 Subject: [PATCH 5/5] fix garbled print statement for scalars * don't print messages if nstate is not created --- mediator/med.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 4e1f916f..3133c7f8 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -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,*)