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

Add DICE to moab driver #6482

Merged
merged 4 commits into from
Jul 13, 2024
Merged

Add DICE to moab driver #6482

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
6e393f6
data ice branch from data rof
iulian787 Jun 16, 2024
ec58e82
define data ice imoab app before init
iulian787 Jun 16, 2024
ef39f1f
need to compute comm graph between data ice and coupler ice
iulian787 Jun 16, 2024
53be196
add GLOBAL_ID to tags for ice
iulian787 Jun 18, 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
181 changes: 179 additions & 2 deletions components/data_comps/dice/src/dice_comp_mod.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,10 @@ module dice_comp_mod
use dice_shr_mod , only: flux_Qacc0 ! namelist input -initial water accumulation value
use dice_shr_mod , only: nullstr
use dice_flux_atmice_mod, only: dice_flux_atmice

#ifdef HAVE_MOAB
use seq_comm_mct, only : MPSIID ! id of moab ice app
use iso_c_binding
#endif
! !PUBLIC TYPES:
implicit none
private ! except
Expand Down Expand Up @@ -111,6 +114,12 @@ subroutine dice_comp_init(Eclock, x2i, i2x, &
inst_suffix, inst_name, logunit, read_restart, &
scmMode, scmlat, scmlon)

#ifdef HAVE_MOAB
use iMOAB, only: iMOAB_DefineTagStorage, iMOAB_GetDoubleTagStorage, &
iMOAB_SetIntTagStorage, iMOAB_SetDoubleTagStorage, &
iMOAB_ResolveSharedEntities, iMOAB_CreateVertices, &
iMOAB_GetMeshInfo, iMOAB_UpdateMeshInfo, iMOAB_WriteMesh
#endif
! !DESCRIPTION: initialize dice model
implicit none

Expand Down Expand Up @@ -141,7 +150,17 @@ subroutine dice_comp_init(Eclock, x2i, i2x, &
logical :: exists ! file existance logical
integer(IN) :: nu ! unit number
character(CL) :: calendar ! calendar type

#ifdef HAVE_MOAB
character*400 tagname
real(R8) latv, lonv
integer iv, tagindex, ilat, ilon, ierr !, arrsize, nfields
real(R8), allocatable, target :: data(:)
integer(IN), pointer :: idata(:) ! temporary
real(r8), dimension(:), allocatable :: moab_vert_coords ! temporary
#ifdef MOABDEBUG
character*100 outfile, wopts
#endif
#endif
!--- formats ---
character(*), parameter :: F00 = "('(dice_comp_init) ',8a)"
character(*), parameter :: F0L = "('(dice_comp_init) ',a, l2)"
Expand Down Expand Up @@ -219,6 +238,120 @@ subroutine dice_comp_init(Eclock, x2i, i2x, &
call shr_dmodel_rearrGGrid(SDICE%grid, ggrid, gsmap, rearr, mpicom)
call t_stopf('dice_initmctdom')

#ifdef HAVE_MOAB
ilat = mct_aVect_indexRA(ggrid%data,'lat')
ilon = mct_aVect_indexRA(ggrid%data,'lon')
allocate(moab_vert_coords(lsize*3))
do iv = 1, lsize
lonv = ggrid%data%rAttr(ilon, iv) * SHR_CONST_PI/180.
latv = ggrid%data%rAttr(ilat, iv) * SHR_CONST_PI/180.
moab_vert_coords(3*iv-2)=COS(latv)*COS(lonv)
moab_vert_coords(3*iv-1)=COS(latv)*SIN(lonv)
moab_vert_coords(3*iv )=SIN(latv)
enddo

! create the vertices with coordinates from MCT domain
ierr = iMOAB_CreateVertices(MPSIID, lsize*3, 3, moab_vert_coords)
if (ierr .ne. 0) &
call shr_sys_abort('Error: fail to create MOAB vertices in data ice model')

tagname='GLOBAL_ID'//C_NULL_CHAR
ierr = iMOAB_DefineTagStorage(MPSIID, tagname, &
0, & ! dense, integer
1, & ! number of components
tagindex )
if (ierr .ne. 0) &
call shr_sys_abort('Error: fail to retrieve GLOBAL_ID tag ')

! get list of global IDs for Dofs
call mct_gsMap_orderedPoints(gsMap, my_task, idata)

ierr = iMOAB_SetIntTagStorage ( MPSIID, tagname, lsize, &
0, & ! vertex type
idata)
if (ierr .ne. 0) &
call shr_sys_abort('Error: fail to set GLOBAL_ID tag ')

ierr = iMOAB_ResolveSharedEntities( MPSIID, lsize, idata );
if (ierr .ne. 0) &
call shr_sys_abort('Error: fail to resolve shared entities')

deallocate(moab_vert_coords)
deallocate(idata)

ierr = iMOAB_UpdateMeshInfo( MPSIID )
if (ierr .ne. 0) &
call shr_sys_abort('Error: fail to update mesh info ')

allocate(data(lsize))
ierr = iMOAB_DefineTagStorage( MPSIID, "area:aream:frac:mask"//C_NULL_CHAR, &
1, & ! dense, double
1, & ! number of components
tagindex )
if (ierr > 0 ) &
call shr_sys_abort('Error: fail to create tag: area:aream:frac:mask' )

data(:) = ggrid%data%rAttr(mct_aVect_indexRA(ggrid%data,'area'),:)
tagname='area'//C_NULL_CHAR
ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, lsize, &
0, & ! set data on vertices
data)
if (ierr > 0 ) &
call shr_sys_abort('Error: fail to get area tag ')

! set the same data for aream (model area) as area
! data(:) = ggrid%data%rAttr(mct_aVect_indexRA(ggrid%data,'aream'),:)
tagname='aream'//C_NULL_CHAR
ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, lsize, &
0, & ! set data on vertices
data)
if (ierr > 0 ) &
call shr_sys_abort('Error: fail to set aream tag ')

data(:) = ggrid%data%rAttr(mct_aVect_indexRA(ggrid%data,'mask'),:)
tagname='mask'//C_NULL_CHAR
ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, lsize, &
0, & ! set data on vertices
data)
if (ierr > 0 ) &
call shr_sys_abort('Error: fail to set mask tag ')

data(:) = ggrid%data%rAttr(mct_aVect_indexRA(ggrid%data,'frac'),:)
tagname='frac'//C_NULL_CHAR
ierr = iMOAB_SetDoubleTagStorage ( MPSIID, tagname, lsize, &
0, & ! set data on vertices
data)
if (ierr > 0 ) &
call shr_sys_abort('Error: fail to set frac tag ')

deallocate(data)

! define tags
ierr = iMOAB_DefineTagStorage( MPSIID, trim(seq_flds_x2i_fields)//C_NULL_CHAR, &
1, & ! dense, double
1, & ! number of components
tagindex )
if (ierr > 0 ) &
call shr_sys_abort('Error: fail to create seq_flds_x2i_fields tags ')

ierr = iMOAB_DefineTagStorage( MPSIID, trim(seq_flds_i2x_fields)//C_NULL_CHAR, &
1, & ! dense, double
1, & ! number of components
tagindex )
if (ierr > 0 ) &
call shr_sys_abort('Error: fail to create seq_flds_i2x_fields tags ')
#ifdef MOABDEBUG
! debug test
outfile = 'IceDataMesh.h5m'//C_NULL_CHAR
wopts = ';PARALLEL=WRITE_PART'//C_NULL_CHAR !
! write out the mesh file to disk
ierr = iMOAB_WriteMesh(MPSIID, trim(outfile), trim(wopts))
if (ierr .ne. 0) then
call shr_sys_abort(subname//' ERROR in writing data mesh ice ')
endif
#endif
#endif

!----------------------------------------------------------------------------
! Initialize MCT attribute vectors
!----------------------------------------------------------------------------
Expand Down Expand Up @@ -388,6 +521,13 @@ subroutine dice_comp_run(EClock, x2i, i2x, &
inst_suffix, logunit, read_restart, case_name)
use shr_cal_mod, only : shr_cal_ymdtod2string
! !DESCRIPTION: run method for dice model
#ifdef MOABDEBUG
use iMOAB, only: iMOAB_WriteMesh
#endif
#ifdef HAVE_MOAB
use seq_flds_mod , only: seq_flds_i2x_fields
use seq_flds_mod , only: moab_set_tag_from_av
#endif
implicit none

! !INPUT/OUTPUT PARAMETERS:
Expand Down Expand Up @@ -423,6 +563,17 @@ subroutine dice_comp_run(EClock, x2i, i2x, &
logical :: write_restart ! restart now
character(len=18) :: date_str

#ifdef HAVE_MOAB
real(R8), allocatable, target :: datam(:)
type(mct_list) :: temp_list
integer :: size_list, index_list
type(mct_string) :: mctOStr !
character*400 tagname, mct_field
#ifdef MOABDEBUG
integer :: cur_dice_stepno, ierr
character*100 outfile, wopts, lnum
#endif
#endif
character(*), parameter :: F00 = "('(dice_comp_run) ',8a)"
character(*), parameter :: F04 = "('(dice_comp_run) ',2a,2i8,'s')"
character(*), parameter :: subName = "(dice_comp_run) "
Expand Down Expand Up @@ -671,6 +822,32 @@ subroutine dice_comp_run(EClock, x2i, i2x, &

call t_stopf('dice')

#ifdef HAVE_MOAB
lsize = mct_avect_lsize(i2x) ! is it the same as mct_avect_lsize(avstrm) ?
allocate(datam(lsize)) !
call mct_list_init(temp_list ,seq_flds_i2x_fields)
size_list=mct_list_nitem (temp_list)
do index_list = 1, size_list
call mct_list_get(mctOStr,index_list,temp_list)
mct_field = mct_string_toChar(mctOStr)
tagname= trim(mct_field)//C_NULL_CHAR
call moab_set_tag_from_av(tagname, i2x, index_list, MPSIID, datam, lsize) ! loop over all a2x fields, not just a few
enddo
call mct_list_clean(temp_list)
deallocate(datam) ! maybe we should keep it around, deallocate at the final only?

#ifdef MOABDEBUG
call seq_timemgr_EClockGetData( EClock, stepno=cur_dice_stepno )
write(lnum,"(I0.2)")cur_dice_stepno
outfile = 'dice_comp_run_'//trim(lnum)//'.h5m'//C_NULL_CHAR
wopts = 'PARALLEL=WRITE_PART'//C_NULL_CHAR
ierr = iMOAB_WriteMesh(MPSIID, outfile, wopts)
if (ierr > 0 ) then
write(logunit,*) 'Failed to write data ice component state '
endif
#endif

#endif
!----------------------------------------------------------------------------
! Log output for model date
!----------------------------------------------------------------------------
Expand Down
39 changes: 36 additions & 3 deletions components/data_comps/dice/src/ice_comp_mct.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,11 @@ module ice_comp_mct
use dice_comp_mod , only: dice_comp_init, dice_comp_run, dice_comp_final
use dice_shr_mod , only: dice_shr_read_namelists
use seq_flds_mod , only: seq_flds_i2x_fields, seq_flds_x2i_fields, seq_flds_i2o_per_cat

#ifdef HAVE_MOAB
use seq_comm_mct, only : MPSIID ! iMOAB app id for ice
use iso_c_binding
use iMOAB , only: iMOAB_RegisterApplication
#endif
! !PUBLIC TYPES:
implicit none
private ! except
Expand Down Expand Up @@ -51,7 +55,9 @@ module ice_comp_mct

!===============================================================================
subroutine ice_init_mct( EClock, cdata, x2i, i2x, NLFilename )

#ifdef HAVE_MOAB
use shr_stream_mod, only: shr_stream_getDomainInfo, shr_stream_getFile
#endif
! !DESCRIPTION: initialize dice model
implicit none

Expand All @@ -73,6 +79,16 @@ subroutine ice_init_mct( EClock, cdata, x2i, i2x, NLFilename )
logical :: scmMode = .false. ! single column mode
real(R8) :: scmLat = shr_const_SPVAL ! single column lat
real(R8) :: scmLon = shr_const_SPVAL ! single column lon
#ifdef HAVE_MOAB
character(CL) :: filePath ! generic file path
character(CL) :: fileName ! generic file name
character(CS) :: timeName ! domain file: time variable name
character(CS) :: lonName ! domain file: lon variable name
character(CS) :: latName ! domain file: lat variable name
character(CS) :: hgtName ! domain file: hgt variable name
character(CS) :: maskName ! domain file: mask variable name
character(CS) :: areaName ! domain file: area variable name
#endif
character(*), parameter :: subName = "(ice_init_mct) "
!-------------------------------------------------------------------------------

Expand Down Expand Up @@ -139,13 +155,30 @@ subroutine ice_init_mct( EClock, cdata, x2i, i2x, NLFilename )
!----------------------------------------------------------------------------
! Initialize dice
!----------------------------------------------------------------------------

#ifdef HAVE_MOAB
ierr = iMOAB_RegisterApplication(trim("DICE")//C_NULL_CHAR, mpicom, compid, MPSIID)
if (ierr .ne. 0) then
write(logunit,*) subname,' error in registering data ice comp'
call shr_sys_abort(subname//' ERROR in registering data ice comp')
endif
#endif
call dice_comp_init(Eclock, x2i, i2x, &
seq_flds_x2i_fields, seq_flds_i2x_fields, seq_flds_i2o_per_cat, &
SDICE, gsmap, ggrid, mpicom, compid, my_task, master_task, &
inst_suffix, inst_name, logunit, read_restart, &
scmMode, scmlat, scmlon)


#ifdef HAVE_MOAB
if (my_task == master_task) then
call shr_stream_getDomainInfo(SDICE%stream(1), filePath,fileName,timeName,lonName, &
latName,hgtName,maskName,areaName)
call shr_stream_getFile(filePath,fileName)
! send path of ice domain to MOAB coupler.
call seq_infodata_PutData( infodata, ice_domain=fileName)
write(logunit,*), ' filename: ', filename
endif
#endif
!----------------------------------------------------------------------------
! Fill infodata that needs to be returned from dice
!----------------------------------------------------------------------------
Expand Down
Loading