diff --git a/mediator/med.F90 b/mediator/med.F90 index 4e1f916f3..3133c7f88 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,*) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 6966a37d2..1b89f4634 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -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) @@ -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)) @@ -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) @@ -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 @@ -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" @@ -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 diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 0a6a7775d..c895d6c42 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 @@ -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 @@ -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 @@ -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 @@ -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