From 3fedc78b1b012f8bd6c0fde7c1b41e79b9db63a9 Mon Sep 17 00:00:00 2001 From: TRasmussen <33480590+TillRasmussen@users.noreply.github.com> Date: Wed, 24 Jun 2020 01:51:04 +0200 Subject: [PATCH] Allow for read of tlat, tlon, anglet with popgrid (#463) 1/ To fix bug in ice_Transport driver .F90 (original pull request) 2/ Fix bug when cpp flag NEMO_IN_CICE is enabled. ice_step_mod.F90 uses variable raice without declaring. 3/ Allow for reading angle, tlon tlat if angle exist in netcdf grid file. If these are read they will not be calculated. This will cause differences when either of these three variables are used or dumped to output. If angle do not exist the routine will calculate angle, tlon and tlat as previous. --- .../dynamics/ice_transport_driver.F90 | 8 +- cicecore/cicedynB/general/ice_step_mod.F90 | 6 +- cicecore/cicedynB/infrastructure/ice_grid.F90 | 61 +- cicecore/drivers/nuopc/dmi/cice_cap.info | 1031 +++++++++++++++++ 4 files changed, 1085 insertions(+), 21 deletions(-) create mode 100644 cicecore/drivers/nuopc/dmi/cice_cap.info diff --git a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 index 037e40e04..c500e1631 100644 --- a/cicecore/cicedynB/dynamics/ice_transport_driver.F90 +++ b/cicecore/cicedynB/dynamics/ice_transport_driver.F90 @@ -609,8 +609,8 @@ subroutine transport_remap (dt) asum_init(0), asum_final(0)) if (l_stop) then - write (nu_diag,*) 'istep1, my_task, iblk =', & - istep1, my_task, iblk + write (nu_diag,*) 'istep1, my_task =', & + istep1, my_task write (nu_diag,*) 'transport: conservation error, cat 0' call abort_ice(subname//'ERROR: conservation error1') endif @@ -623,8 +623,8 @@ subroutine transport_remap (dt) atsum_init(:,n), atsum_final(:,n)) if (l_stop) then - write (nu_diag,*) 'istep1, my_task, iblk, cat =', & - istep1, my_task, iblk, n + write (nu_diag,*) 'istep1, my_task, cat =', & + istep1, my_task, n write (nu_diag,*) 'transport: conservation error, cat ',n call abort_ice(subname//'ERROR: conservation error2') endif diff --git a/cicecore/cicedynB/general/ice_step_mod.F90 b/cicecore/cicedynB/general/ice_step_mod.F90 index 7f9f316a3..2f1a1c75b 100644 --- a/cicecore/cicedynB/general/ice_step_mod.F90 +++ b/cicecore/cicedynB/general/ice_step_mod.F90 @@ -182,7 +182,6 @@ subroutine step_therm1 (dt, iblk) logical (kind=log_kind) :: & prescribed_ice ! if .true., use prescribed ice instead of computed #endif - real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -190,7 +189,10 @@ subroutine step_therm1 (dt, iblk) iblk ! block index ! local variables - +#ifdef CICE_IN_NEMO + real (kind=dbl_kind) :: & + raice ! temporary reverse ice concentration +#endif integer (kind=int_kind) :: & ilo,ihi,jlo,jhi, & ! beginning and end of physical domain i, j , & ! horizontal indices diff --git a/cicecore/cicedynB/infrastructure/ice_grid.F90 b/cicecore/cicedynB/infrastructure/ice_grid.F90 index 8df66042b..f4b5fef6e 100644 --- a/cicecore/cicedynB/infrastructure/ice_grid.F90 +++ b/cicecore/cicedynB/infrastructure/ice_grid.F90 @@ -133,6 +133,10 @@ module ice_grid real (kind=dbl_kind), dimension (:,:,:), allocatable, public :: & rndex_global ! global index for local subdomain (dbl) + logical (kind=log_kind), private :: & + l_readCenter ! If anglet exist in grid file read it otherwise calculate it + + !======================================================================= contains @@ -332,7 +336,6 @@ subroutine init_grid2 real (kind=dbl_kind) :: & angle_0, angle_w, angle_s, angle_sw, & pi, pi2, puny -! real (kind=dbl_kind) :: ANGLET_dum logical (kind=log_kind), dimension(nx_block,ny_block,max_blocks):: & out_of_range @@ -470,11 +473,10 @@ subroutine init_grid2 !----------------------------------------------------------------- ! Compute ANGLE on T-grid !----------------------------------------------------------------- - ANGLET = c0 - if (trim(grid_type) == 'cpom_grid') then ANGLET(:,:,:) = ANGLE(:,:,:) - else + else if (.not. (l_readCenter)) then + ANGLET = c0 !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block, & !$OMP angle_0,angle_w,angle_s,angle_sw) @@ -504,7 +506,8 @@ subroutine init_grid2 enddo !$OMP END PARALLEL DO endif ! cpom_grid - if (trim(grid_type) == 'regional') then + if (trim(grid_type) == 'regional' .and. & + (.not. (l_readCenter))) then ! for W boundary extrapolate from interior !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) do iblk = 1, nblocks @@ -531,9 +534,9 @@ subroutine init_grid2 call ice_timer_stop(timer_bound) call makemask ! velocity mask, hemisphere masks - - call Tlatlon ! get lat, lon on the T grid - + if (.not. (l_readCenter)) then + call Tlatlon ! get lat, lon on the T grid + endif !----------------------------------------------------------------- ! bathymetry !----------------------------------------------------------------- @@ -716,6 +719,7 @@ subroutine popgrid_nc field_loc_center, field_loc_NEcorner, & field_type_scalar, field_type_angle use ice_domain_size, only: max_blocks + use netcdf integer (kind=int_kind) :: & i, j, iblk, & @@ -739,6 +743,12 @@ subroutine popgrid_nc type (block) :: & this_block ! block information for current block + + integer(kind=int_kind) :: & + varid + integer (kind=int_kind) :: & + status ! status flag + character(len=*), parameter :: subname = '(popgrid_nc)' @@ -751,7 +761,7 @@ subroutine popgrid_nc call ice_open_nc(kmt_file,fid_kmt) diag = .true. ! write diagnostic info - + l_readCenter = .false. !----------------------------------------------------------------- ! topography !----------------------------------------------------------------- @@ -806,11 +816,37 @@ subroutine popgrid_nc call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! ANGLE call scatter_global(ANGLE, work_g1, master_task, distrb_info, & field_loc_NEcorner, field_type_angle) - ! fix ANGLE: roundoff error due to single precision where (ANGLE > pi) ANGLE = pi where (ANGLE < -pi) ANGLE = -pi + ! if grid file includes anglet then read instead + fieldname='anglet' + if (my_task == master_task) then + status = nf90_inq_varid(fid_grid, trim(fieldname) , varid) + if (status /= nf90_noerr) then + write(nu_diag,*) subname//' CICE will calculate angleT, TLON and TLAT' + else + write(nu_diag,*) subname//' angleT, TLON and TLAT is read from grid file' + l_readCenter = .true. + endif + endif + call broadcast_scalar(l_readCenter,master_task) + if (l_readCenter) then + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) + call scatter_global(ANGLET, work_g1, master_task, distrb_info, & + field_loc_center, field_type_angle) + where (ANGLET > pi) ANGLET = pi + where (ANGLET < -pi) ANGLET = -pi + fieldname="tlon" + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) + call scatter_global(TLON, work_g1, master_task, distrb_info, & + field_loc_center, field_type_scalar) + fieldname="tlat" + call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) + call scatter_global(TLAT, work_g1, master_task, distrb_info, & + field_loc_center, field_type_scalar) + endif !----------------------------------------------------------------- ! cell dimensions ! calculate derived quantities from global arrays to preserve @@ -820,7 +856,6 @@ subroutine popgrid_nc fieldname='htn' call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! HTN call primary_grid_lengths_HTN(work_g1) ! dxu, dxt - fieldname='hte' call ice_read_global_nc(fid_grid,1,fieldname,work_g1,diag) ! HTE call primary_grid_lengths_HTE(work_g1) ! dyu, dyt @@ -831,7 +866,6 @@ subroutine popgrid_nc call ice_close_nc(fid_grid) call ice_close_nc(fid_kmt) endif - #endif end subroutine popgrid_nc @@ -1737,7 +1771,6 @@ subroutine Tlatlon enddo ! j enddo ! iblk !$OMP END PARALLEL DO - if (trim(grid_type) == 'regional') then ! for W boundary extrapolate from interior !$OMP PARALLEL DO PRIVATE(iblk,i,j,ilo,ihi,jlo,jhi,this_block) @@ -2463,7 +2496,6 @@ subroutine read_basalstress_bathy ! use module use ice_read_write - use ice_communicate, only: my_task, master_task use ice_constants, only: field_loc_center, field_type_scalar ! local variables @@ -2491,7 +2523,6 @@ subroutine read_basalstress_bathy if (my_task == master_task) then write(nu_diag,*) 'reading ',TRIM(fieldname) - write(*,*) 'reading ',TRIM(fieldname) call icepack_warnings_flush(nu_diag) endif call ice_read_nc(fid_init,1,fieldname,bathymetry,diag, & diff --git a/cicecore/drivers/nuopc/dmi/cice_cap.info b/cicecore/drivers/nuopc/dmi/cice_cap.info new file mode 100644 index 000000000..49127cc15 --- /dev/null +++ b/cicecore/drivers/nuopc/dmi/cice_cap.info @@ -0,0 +1,1031 @@ +module cice_cap +!--------------- LANL CICE NUOPC CAP ----------------- +! This is the DMI CICE model cap component that is NUOPC compliant. +! Author: Fei.Liu@gmail.com +! 5/10/13 +! This is now acting as a cap/connector between NUOPC driver and LANL CICE code. +! Author: Anthony.Craig@gmail.com +! Added cice grid code to match internal grid representation +! Updated by Till Rasmussen, DMI + +! cice specific + use ice_blocks, only: nx_block, ny_block, nblocks_tot, block, get_block, & + get_block_parameter + use ice_domain_size, only: max_blocks, nx_global, ny_global + use ice_domain, only: nblocks, blocks_ice, distrb_info + use ice_distribution, only: ice_distributiongetblockloc + use icepack_parameters, only: Tffresh, rad_to_deg + use ice_calendar, only: dt + use ice_flux + use ice_grid, only: TLAT, TLON, ULAT, ULON, hm, tarea, ANGLET, ANGLE, & + dxt, dyt, t2ugrid_vector + use ice_state + use CICE_RunMod + use CICE_InitMod + use CICE_FinalMod +!end cice specific + use ESMF + use NUOPC + use mod_nuopc_options, only: esmf_write_diagnostics + use NUOPC_Model, & + model_routine_SS => SetServices, & + model_label_SetClock => label_SetClock, & + model_label_Advance => label_Advance, & + model_label_Finalize => label_Finalize + + implicit none + + private + + public SetServices + +! type cice_internalstate_type +! end type + +! type cice_internalstate_wrapper +! type(cice_internalstate_type), pointer :: ptr +! end type + + integer :: import_slice = 0 + integer :: export_slice = 0 + + type fld_list_type + character(len=64) :: stdname + character(len=64) :: shortname + character(len=64) :: canonicalUnits + character(len=64) :: transferOffer + logical :: assoc ! is the farrayPtr associated with internal data + real(ESMF_KIND_R8), dimension(:,:,:), pointer :: farrayPtr + end type fld_list_type + + integer,parameter :: fldsMax = 50 + integer :: fldsToIce_num = 0 + type (fld_list_type) :: fldsToIce(fldsMax) + integer :: fldsFrIce_num = 0 + type (fld_list_type) :: fldsFrIce(fldsMax) + +!tarnotused integer :: lsize ! local number of gridcells for coupling + character(len=256) :: tmpstr + character(len=2048):: info + logical :: isPresent + integer :: dbrc ! temporary debug rc value + + logical :: profile_memory = .true. + + contains + !----------------------------------------------------------------------------- + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + character(len=*),parameter :: subname='(cice:SetServices)' + rc = ESMF_SUCCESS + + ! the NUOPC model component will register the generic methods + call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! set entry point for methods that require specific implementation + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv00p1"/), userRoutine=InitializeAdvertise, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & + phaseLabelList=(/"IPDv00p2"/), userRoutine=InitializeRealize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! attach specializing method(s) + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetClock, & + specRoutine=SetClock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, & + specRoutine=ModelAdvance, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + + call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, & + specRoutine=cice_model_finalize, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine + + !----------------------------------------------------------------------------- + + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + ! Local Variables + type(ESMF_VM) :: vm + integer :: mpi_comm + character(len=*),parameter :: subname='(cice_cap:InitializeAdvertise)' + rc = ESMF_SUCCESS + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_VMGet(vm, mpiCommunicator=mpi_comm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call CICE_FieldsSetup() + call CICE_Initialize(mpi_comm) + + call CICE_AdvertiseFields(importState, fldsToIce_num, fldsToIce, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call CICE_AdvertiseFields(exportState, fldsFrIce_num, fldsFrIce, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + write(info,*) subname,' --- initialization phase 1 completed --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine + + !----------------------------------------------------------------------------- + + subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp + type(ESMF_State) :: importState, exportState + type(ESMF_Clock) :: clock + integer, intent(out) :: rc + + ! Local Variables + type(ESMF_VM) :: vm + type(ESMF_Grid) :: gridIn + type(ESMF_Grid) :: gridOut + type(ESMF_DistGrid) :: distgrid + type(ESMF_DistGridConnection), allocatable :: connectionList(:) + integer :: npet + integer :: i,j,iblk, n, i1,j1, DE + integer :: ilo,ihi,jlo,jhi + integer :: ig,jg,cnt + integer :: peID,locID + integer :: peIDCount + integer, pointer :: indexList(:) + integer, pointer :: deLabelList(:) + integer, pointer :: deBlockList(:,:,:) + integer, pointer :: petMap(:) + integer, pointer :: i_glob(:),j_glob(:) + integer :: lbnd(2),ubnd(2) + type(block) :: this_block + type(ESMF_DELayout) :: delayout + real(ESMF_KIND_R8), pointer :: tarray(:,:) + real(ESMF_KIND_R8), pointer :: coordXcenter(:,:) + real(ESMF_KIND_R8), pointer :: coordYcenter(:,:) + real(ESMF_KIND_R8), pointer :: coordXcorner(:,:) + real(ESMF_KIND_R8), pointer :: coordYcorner(:,:) + integer(ESMF_KIND_I4), pointer :: gridmask(:,:) + real(ESMF_KIND_R8), pointer :: gridarea(:,:) + character(len=*),parameter :: subname='(cice_cap:InitializeRealize)' + rc = ESMF_SUCCESS + + ! We can check if npet is 4 or some other value to make sure + ! CICE is configured to run on the correct number of processors. + + ! create a Grid object for Fields + ! we are going to create a single tile displaced pole grid from a gridspec + ! file. We also use the exact decomposition in CICE so that the Fields + ! created can wrap on the data pointers in internal part of CICE + write(tmpstr,'(a,2i8)') subname//' ice nx,ny = ',nx_global,ny_global + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + +! distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nx_global,ny_global/), & +! regDecomp=(/2,2/), rc=rc) + + allocate(deBlockList(2,2,nblocks_tot)) + allocate(petMap(nblocks_tot)) + allocate(deLabelList(nblocks_tot)) + + write(tmpstr,'(a,2i8)') subname//' nblocks = ',nblocks_tot, nblocks + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + peIDCount = 0 + do n = 1, nblocks_tot + deLabelList(n) = n-1 + call get_block_parameter(n,ilo=ilo,ihi=ihi,jlo=jlo,jhi=jhi, & + i_glob=i_glob,j_glob=j_glob) +! deBlockList(1,1,n) = i_glob(ilo) +! deBlockList(1,2,n) = i_glob(ihi) +! deBlockList(2,1,n) = j_glob(jlo) +! deBlockList(2,2,n) = j_glob(jhi) + call ice_distributionGetBlockLoc(distrb_info,n,peID,locID) + if (peID > 0) then + peIDCount = peIDCount+1 + petMap(peIDCount) = peID-1 + deBlockList(1,1,peIDCount) = i_glob(ilo) + deBlockList(1,2,peIDCount) = i_glob(ihi) + deBlockList(2,1,peIDCount) = j_glob(jlo) + deBlockList(2,2,PeIDCount) = j_glob(jhi) + write(tmpstr,'(a,4i8)') subname//' ID2s = ',n,peID, locID, nblocks + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !reducepetmappetMap(n) = max(0,peID - 1) + write(tmpstr,'(a,4i8)') subname//' IDs = ',n,peID, locID, nblocks + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,3i8)') subname//' iglo = ',n,deBlockList(1,1,peIDCount),deBlockList(1,2,peIDCount) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + write(tmpstr,'(a,3i8)') subname//' jglo = ',n,deBlockList(2,1,peIDCount),deBlockList(2,2,peIDCount) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + endif + enddo + write(tmpstr,'(a,1i8)') subname//' npeID ',peIDCount + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) +!!!TAR ADDED 141119 + delayout = ESMF_DELayoutCreate(petMap(1:peIDCount), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + +!tarnotglobal allocate(connectionList(2)) + ! bipolar boundary condition at top row: nyg +!tarnotglobal call ESMF_DistGridConnectionSet(connectionList(1), tileIndexA=1, & +!tarnotglobal tileIndexB=1, positionVector=(/nx_global+1, 2*ny_global+1/), & +!tarnotglobal orientationVector=(/-1, -2/), rc=rc) +!tarnotglobal if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +!tarnotglobal line=__LINE__, & +!tarnotglobal file=__FILE__)) & +!tarnotglobal return ! bail out + ! periodic boundary condition along first dimension +!tarnotglobal call ESMF_DistGridConnectionSet(connectionList(2), tileIndexA=1, & +!tarnotglobal tileIndexB=1, positionVector=(/nx_global, 0/), rc=rc) +!tarnotglobal if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & +!tarnotglobal line=__LINE__, & +!tarnotglobal file=__FILE__)) & +!tarnotglobal return ! bail out + + distgrid = ESMF_DistGridCreate(minIndex=(/1,1/), maxIndex=(/nx_global,ny_global/), & +! indexflag = ESMF_INDEX_DELOCAL, & + deBlockList=deBlockList(:,:,1:peIDCount), & +! deLabelList=deLabelList, & + delayout=delayout, & +!tarnotglobal connectionList=connectionList, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + deallocate(deLabelList) + deallocate(deBlockList) + deallocate(petMap) +!tarnotglobal deallocate(connectionList) + + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, elementCount=cnt, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + allocate(indexList(cnt)) + write(tmpstr,'(a,i8)') subname//' distgrid cnt= ',cnt + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_DistGridGet(distgrid=distgrid, localDE=0, seqIndexList=indexList, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + write(tmpstr,'(a,4i8)') subname//' distgrid list= ',indexList(1),indexList(cnt),minval(indexList), maxval(indexList) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + deallocate(IndexList) + + gridIn = ESMF_GridCreate(distgrid=distgrid, & + coordSys = ESMF_COORDSYS_SPH_DEG, & + gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), & + rc = rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridAddCoord(gridIn, staggerLoc=ESMF_STAGGERLOC_CORNER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_MASK, itemTypeKind=ESMF_TYPEKIND_I4, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridAddItem(gridIn, itemFlag=ESMF_GRIDITEM_AREA, itemTypeKind=ESMF_TYPEKIND_R8, & + staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do iblk = 1,nblocks + DE = iblk-1 + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + + call ESMF_GridGetCoord(gridIn, coordDim=1, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + computationalLBound=lbnd, computationalUBound=ubnd, & + farrayPtr=coordXcenter, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(gridIn, coordDim=2, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=coordYcenter, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(tmpstr,'(a,5i8)') subname//' iblk center bnds ',iblk,lbnd,ubnd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + if (lbnd(1) /= 1 .or. lbnd(2) /= 1 .or. ubnd(1) /= ihi-ilo+1 .or. ubnd(2) /= jhi-jlo+1) then + write(tmpstr,'(a,5i8)') subname//' iblk bnds ERROR ' + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) + write(tmpstr,'(a,4i8)') subname//' iblk center bnds 2',ihi, ilo, jhi,jlo + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) + rc = ESMF_FAILURE + return + endif + + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_MASK, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=gridmask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetItem(gridIn, itemflag=ESMF_GRIDITEM_AREA, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=gridarea, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + do j1 = lbnd(2),ubnd(2) + do i1 = lbnd(1),ubnd(1) + i = i1 + ilo - lbnd(1) + j = j1 + jlo - lbnd(2) + coordXcenter(i1,j1) = TLON(i,j,iblk) * rad_to_deg + coordYcenter(i1,j1) = TLAT(i,j,iblk) * rad_to_deg + gridmask(i1,j1) = nint(hm(i,j,iblk)) + gridarea(i1,j1) = tarea(i,j,iblk) + enddo + enddo + + call ESMF_GridGetCoord(gridIn, coordDim=1, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + computationalLBound=lbnd, computationalUBound=ubnd, & + farrayPtr=coordXcorner, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(gridIn, coordDim=2, localDE=DE, & + staggerloc=ESMF_STAGGERLOC_CORNER, & + farrayPtr=coordYcorner, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write(tmpstr,'(a,5i8)') subname//' iblk corner bnds ',iblk,lbnd,ubnd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + ! ULON and ULAT are upper right hand corner from TLON and TLAT + ! corners in ESMF need to be defined lon lower left corner from center + ! ULON and ULAT have ghost cells, leverage that to fill corner arrays + do j1 = lbnd(2),ubnd(2) + do i1 = lbnd(1),ubnd(1) + i = i1 + ilo - lbnd(1) + j = j1 + jlo - lbnd(2) + coordXcorner(i1,j1) = ULON(i-1,j-1,iblk) * rad_to_deg + coordYcorner(i1,j1) = ULAT(i-1,j-1,iblk) * rad_to_deg + enddo + enddo + + enddo + + call ESMF_GridGetCoord(gridIn, coordDim=1, localDE=0, & + staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=tarray, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,2g15.7)') subname//' gridIn center1 = ',minval(tarray),maxval(tarray) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_GridGetCoord(gridIn, coordDim=2, localDE=0, & + staggerLoc=ESMF_STAGGERLOC_CENTER, farrayPtr=tarray, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,2g15.7)') subname//' gridIn center2 = ',minval(tarray),maxval(tarray) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_GridGetCoord(gridIn, coordDim=1, localDE=0, & + staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=tarray, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,2g15.7)') subname//' gridIn corner1 = ',minval(tarray),maxval(tarray) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + call ESMF_GridGetCoord(gridIn, coordDim=2, localDE=0, & + staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=tarray, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + write(tmpstr,'(a,2g15.7)') subname//' gridIn corner2 = ',minval(tarray),maxval(tarray) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + !TAR FOR NOW GRIDS ARE ASSUMED IDENTICAL. THIS MAY change at a later state. Not necessary + gridOut = gridIn ! for now out same as in +! ice_grid_i = gridIn + + call CICE_RealizeFields(importState, gridIn , fldsToIce_num, fldsToIce, "Ice import", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call CICE_RealizeFields(exportState, gridOut, fldsFrIce_num, fldsFrIce, "Ice export", rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! Import data to CICE native structures through glue fields. + call CICE_Import(importState,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + ! Export CICE native structures to data through glue fields. + CALL CICE_export(exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + write(info,*) subname,' --- initialization phase 2 completed --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) + + end subroutine + + !----------------------------------------------------------------------------- + + ! CICE model uses same clock as parent gridComp + subroutine SetClock(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_TimeInterval) :: stabilityTimeStep, timestep + character(len=*),parameter :: subname='(cice_cap:SetClock)' + + rc = ESMF_SUCCESS + ! query the Component for its clock, importState and exportState + call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! tcraig: dt is the cice thermodynamic timestep in seconds + call ESMF_TimeIntervalSet(timestep, s=nint(dt), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockSet(clock, timestep=timestep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! initialize internal clock + ! here: parent Clock and stability timeStep determine actual model timeStep + call ESMF_TimeIntervalSet(stabilityTimeStep, s=nint(dt), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call NUOPC_CompSetClock(gcomp, clock, stabilityTimeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + end subroutine + + !----------------------------------------------------------------------------- + + subroutine ModelAdvance(gcomp, rc) + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_State) :: importState, exportState + type(ESMF_Time) :: currTime + type(ESMF_TimeInterval) :: timeStep + type(ESMF_Field) :: lfield,lfield2d + type(ESMF_Grid) :: grid + real(ESMF_KIND_R8), pointer :: fldptr(:,:,:) + real(ESMF_KIND_R8), pointer :: fldptr2d(:,:) + type(block) :: this_block + character(len=64) :: fldname + integer :: i,j,iblk,n,i1,i2,j1,j2 + integer :: ilo,ihi,jlo,jhi + real(ESMF_KIND_R8) :: ue, vn, ui, vj +! real(ESMF_KIND_R8) :: sigma_r, sigma_l, sigma_c + type(ESMF_StateItem_Flag) :: itemType + character(240) :: msgString + character(len=*),parameter :: subname='(cice_cap:ModelAdvance)' + rc = ESMF_SUCCESS + if(profile_memory) call ESMF_VMLogMemInfo("Entering CICE Model_ADVANCE: ") + write(info,*) subname,' --- run phase 1 called --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + import_slice = import_slice + 1 + export_slice = export_slice + 1 + + ! query the Component for its clock, importState and exportState + call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, & + exportState=exportState, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + ! HERE THE MODEL ADVANCES: currTime -> currTime + timeStep + + ! Because of the way that the internal Clock was set in SetClock(), + ! its timeStep is likely smaller than the parent timeStep. As a consequence + ! the time interval covered by a single parent timeStep will result in + ! multiple calls to the ModelAdvance() routine. Every time the currTime + ! will come in by one internal timeStep advanced. This goes until the + ! stopTime of the internal Clock has been reached. + + call ESMF_ClockPrint(clock, options="currTime", & + preString="------>Advancing CICE from: ", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, timeStep=timeStep, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_TimePrint(currTime + timeStep, & + preString="--------------------------------> to: ", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out +!TODO ADD LOGFOUNDERROR + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call CICE_Import(importState,rc) + if (esmf_write_diagnostics >0) then + if (mod(import_slice,esmf_write_diagnostics)==0) then + call nuopc_write(state=importState,filenamePrefix='Import_CICE', & + timeslice=import_slice/esmf_write_diagnostics,rc=rc) + endif + endif ! write_diagnostics + write(info,*) subname,' --- run phase 2 called --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + if(profile_memory) call ESMF_VMLogMemInfo("Before CICE_Run") + call CICE_Run + + if(profile_memory) call ESMF_VMLogMemInfo("After CICE_Run") + write(info,*) subname,' --- run phase 3 called --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + + !---- local modifications to coupling fields ----- + call CICE_Export(exportState,rc=rc) + if (esmf_write_diagnostics >0) then + if (mod(export_slice,esmf_write_diagnostics)==0) then + call nuopc_write(state=exportState,filenamePrefix='Export_CICE', & + timeslice=export_slice/esmf_write_diagnostics,rc=rc) + endif + endif + !------------------------------------------------- + + !call state_diagnose(exportState, 'cice_export', rc) + write(info,*) subname,' --- run phase 4 called --- ',rc + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + if(profile_memory) call ESMF_VMLogMemInfo("Leaving CICE Model_ADVANCE: ") + end subroutine + + subroutine cice_model_finalize(gcomp, rc) + + ! input arguments + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(len=*),parameter :: subname='(cice_cap:cice_model_finalize)' + + rc = ESMF_SUCCESS + + write(info,*) subname,' --- finalize called --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + + call NUOPC_ModelGet(gcomp, modelClock=clock, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call CICE_Finalize + + write(info,*) subname,' --- finalize completed --- ' + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + + end subroutine cice_model_finalize + + subroutine CICE_AdvertiseFields(state, nfields, field_defs, rc) + + type(ESMF_State), intent(inout) :: state + integer,intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + integer, intent(inout) :: rc + + integer :: i + character(len=*),parameter :: subname='(cice_cap:CICE_AdvertiseFields)' + + rc = ESMF_SUCCESS + !write(6,*) nfields + do i = 1, nfields + if (.not. NUOPC_FieldDictionaryHasEntry(trim(field_defs(i)%stdname))) then + write(6,*) trim(field_defs(i)%stdname), trim(field_defs(i)%canonicalUnits) + call NUOPC_FieldDictionaryAddEntry( & + standardName=trim(field_defs(i)%stdname), & + canonicalUnits=trim(field_defs(i)%canonicalUnits), & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + call ESMF_LogWrite('Advertise: '//trim(field_defs(i)%stdname), ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + call NUOPC_Advertise(state, & + standardName=field_defs(i)%stdname, & + name=field_defs(i)%shortname, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + + enddo + call flush(6) + + end subroutine CICE_AdvertiseFields + + subroutine CICE_RealizeFields(state, grid, nfields, field_defs, tag, rc) + + type(ESMF_State), intent(inout) :: state + type(ESMF_Grid), intent(in) :: grid + integer, intent(in) :: nfields + type(fld_list_type), intent(inout) :: field_defs(:) + character(len=*), intent(in) :: tag + integer, intent(inout) :: rc + + integer :: i + type(ESMF_Field) :: field + integer :: npet, nx, ny, pet, elb(2), eub(2), clb(2), cub(2), tlb(2), tub(2) + type(ESMF_VM) :: vm + character(len=*),parameter :: subname='(cice_cap:CICE_RealizeFields)' + + rc = ESMF_SUCCESS + + do i = 1, nfields + if (field_defs(i)%assoc) then + write(info, *) subname, tag, ' Field ', field_defs(i)%shortname, ':', & + lbound(field_defs(i)%farrayPtr,1), ubound(field_defs(i)%farrayPtr,1), & + lbound(field_defs(i)%farrayPtr,2), ubound(field_defs(i)%farrayPtr,2), & + lbound(field_defs(i)%farrayPtr,3), ubound(field_defs(i)%farrayPtr,3) + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + field = ESMF_FieldCreate(grid=grid, & + farray=field_defs(i)%farrayPtr, indexflag=ESMF_INDEX_DELOCAL, & + ungriddedLBound=(/1/), ungriddedUBound=(/max_blocks/), & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + else + field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, indexflag=ESMF_INDEX_DELOCAL, & + ungriddedLBound=(/1/), ungriddedUBound=(/max_blocks/), & + name=field_defs(i)%shortname, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + if (NUOPC_IsConnected(state, fieldName=field_defs(i)%shortname)) then + call NUOPC_Realize(state, field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + else + call ESMF_LogWrite(subname // tag // " Field "// field_defs(i)%stdname // " is not connected.", & + ESMF_LOGMSG_INFO, & + line=__LINE__, & + file=__FILE__, & + rc=dbrc) + ! TODO: Initialize the value in the pointer to 0 after proper restart is setup + !if(associated(field_defs(i)%farrayPtr) ) field_defs(i)%farrayPtr = 0.0 + ! remove a not connected Field from State + call ESMF_StateRemove(state, (/field_defs(i)%shortname/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, & + file=__FILE__)) & + return ! bail out + endif + + enddo + + + end subroutine CICE_RealizeFields + + !----------------------------------------------------------------------------- + + + !----------------------------------------------------------------------------- + + + !----------------------------------------------------------------------------- + + subroutine State_GetFldPtr(ST, fldname, fldptr, rc) + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(ESMF_KIND_R8), pointer, intent(in) :: fldptr(:,:,:) + integer, intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrc + character(len=*),parameter :: subname='(cice_cap:State_GetFldPtr)' + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=lrc) + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (present(rc)) rc = lrc + + end subroutine State_GetFldPtr + + subroutine CICE_FieldsSetup + character(len=*),parameter :: subname='(cice_cap:CICE_FieldsSetup)' + +!--------- import fields to Sea Ice ------------- + !tartmpwrite(6,*) subname +! tcraig, don't point directly into cice data YET (last field is optional in interface) +! instead, create space for the field when it's "realized". +!TODO REMOVE FIELDS NOT USED TAR +! WILL PROVIDE means that field has its own grid. Can be changed to accept grid from outside + call fld_list_add(fldsToIce_num, fldsToIce, "sea_surface_temperature" ,"K" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "sea_surface_salinity" ,"1" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "sea_level" ,"m" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "sea_surface_slope_zonal" ,"1" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "sea_surface_slope_merid" ,"1" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "ocn_current_zonal" ,"m/s" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "ocn_current_merid" ,"m/s" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "freezing_melting_potential" ,"1" , "will provide") + call fld_list_add(fldsToIce_num, fldsToIce, "mixed_layer_depth" ,"m" , "will provide") +! fields for export + call fld_list_add(fldsFrIce_num, fldsFrIce, "sea_ice_fraction" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "stress_on_ocn_ice_zonal" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "stress_on_ocn_ice_merid" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "sea_ice_temperature" ,"1" , "will provide") +! call fld_list_add(fldsFrIce_num, fldsFrIce, "ice_mask" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "mean_sw_pen_to_ocn" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "mean_fresh_water_to_ocean_rate" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "mean_salt_rate" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "net_heat_flx_to_ocn" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "mean_ice_volume" ,"1" , "will provide") + call fld_list_add(fldsFrIce_num, fldsFrIce, "mean_snow_volume" ,"1" , "will provide") + + end subroutine CICE_FieldsSetup + + !----------------------------------------------------------------------------- + + subroutine fld_list_add(num, fldlist, stdname, canonicalUnits, transferOffer, data, shortname) + ! ---------------------------------------------- + ! Set up a list of field information + ! ---------------------------------------------- + integer, intent(inout) :: num + type(fld_list_type), intent(inout) :: fldlist(:) + character(len=*), intent(in) :: stdname + character(len=*), intent(in) :: canonicalUnits + character(len=*), intent(in) :: transferOffer + real(ESMF_KIND_R8), dimension(:,:,:), optional, target :: data + character(len=*), intent(in),optional :: shortname + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(cice_cap:fld_list_add)' + ! fill in the new entry + + num = num + 1 + if (num > fldsMax) then + call ESMF_LogWrite(trim(subname)//": ERROR num gt fldsMax "//trim(stdname), & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + return + endif + + fldlist(num)%stdname = trim(stdname) + fldlist(num)%canonicalUnits = trim(canonicalUnits) + if (present(shortname)) then + fldlist(num)%shortname = trim(shortname) + else + fldlist(num)%shortname = trim(stdname) + endif + fldlist(num)%transferOffer = trim(transferOffer) + if (present(data)) then + fldlist(num)%assoc = .true. + fldlist(num)%farrayPtr => data + else + fldlist(num)%assoc = .false. + endif + + end subroutine fld_list_add + + !----------------------------------------------------------------------------- + subroutine CICE_Import(st,rc) + type(ESMF_State) :: st + logical :: initflag + integer, intent(out) :: rc + real(kind=ESMF_KIND_R8), pointer :: dataPtr_sst(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_sss(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_ssh(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_sssz(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_sssm(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_ocncz(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_ocncm(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_fmpot(:,:,:) + real(kind=ESMF_KIND_R8), pointer :: dataPtr_mld(:,:,:) + integer :: ilo,ihi,jlo,jhi + integer :: i,j,iblk,n,i1,i2,j1,j2 + real(kind=ESMF_KIND_R8) :: ue, vn, AngT_s + type(block) :: this_block + character(len=*),parameter :: subname='(cice_cap:CICE_Import)' + + call State_getFldPtr(st,'sea_surface_temperature',dataPtr_sst,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_surface_salinity',dataPtr_sss,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_level',dataPtr_ssh,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_surface_slope_zonal',dataPtr_sssz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_surface_slope_merid',dataPtr_sssm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'ocn_current_zonal',dataPtr_ocncz,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'ocn_current_merid',dataPtr_ocncm,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'freezing_melting_potential',dataPtr_fmpot,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mixed_layer_depth',dataPtr_mld,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + do iblk = 1,nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo,jhi + do i = ilo,ihi + i1 = i - ilo + 1 + j1 = j - jlo + 1 + sss (i,j,iblk) = dataPtr_sss (i1,j1,iblk) ! sea surface salinity (maybe for mushy layer) + sst (i,j,iblk) = dataPtr_sst (i1,j1,iblk) - Tffresh ! sea surface temp (may not be needed?) + + frzmlt (i,j,iblk) = dataPtr_fmpot (i1,j1,iblk) + ue = dataPtr_ocncz (i1,j1,iblk) + vn = dataPtr_ocncm (i1,j1,iblk) + AngT_s = ANGLET(i,j,iblk) + uocn (i,j,iblk) = ue*cos(AngT_s) - vn*sin(AngT_s) + vocn (i,j,iblk) = ue*sin(AngT_s) + vn*cos(AngT_s) + ue = dataPtr_sssz (i1,j1,iblk) + vn = dataPtr_sssm (i1,j1,iblk) + ss_tltx(i,j,iblk) = ue*cos(AngT_s) - vn*sin(AngT_s) + ss_tlty(i,j,iblk) = ue*sin(AngT_s) + vn*cos(AngT_s) + enddo + enddo + call t2ugrid_vector(ss_tltx) + call t2ugrid_vector(ss_tlty) + call t2ugrid_vector(uocn) + call t2ugrid_vector(vocn) + enddo + + end subroutine + subroutine CICE_Export(st,rc) + type(ESMF_State) :: st + integer, intent(out) :: rc +! real(ESMF_KIND_R8), pointer :: dataPtr_mask(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_ifrac(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_itemp(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_strocnxT(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_strocnyT(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fhocn(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fresh(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fsalt(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vice(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_vsno(:,:,:) + real(ESMF_KIND_R8), pointer :: dataPtr_fswthru(:,:,:) + + integer :: ilo,ihi,jlo,jhi + integer :: i,j,iblk,n,i1,i2,j1,j2 + real(kind=ESMF_KIND_R8) :: ui, vj, angT + + type(block) :: this_block + character(len=*),parameter :: subname='(cice_cap:CICE_Export)' +!TODO clean up fields +! call State_getFldPtr(st,'ice_mask',dataPtr_mask,rc=rc) +! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_ice_fraction',dataPtr_ifrac,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'sea_ice_temperature',dataPtr_itemp,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'stress_on_ocn_ice_zonal',dataPtr_strocnxT,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'stress_on_ocn_ice_merid',dataPtr_strocnyT,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'net_heat_flx_to_ocn',dataPtr_fhocn,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mean_fresh_water_to_ocean_rate',dataPtr_fresh,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mean_salt_rate',dataPtr_fsalt,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mean_ice_volume',dataPtr_vice,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mean_snow_volume',dataPtr_vsno,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + call State_getFldPtr(st,'mean_sw_pen_to_ocn',dataPtr_fswthru,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU,line=__LINE__,file=__FILE__)) return + + write(info, *) subname//' ifrac size :', & + lbound(dataPtr_ifrac,1), ubound(dataPtr_ifrac,1), & + lbound(dataPtr_ifrac,2), ubound(dataPtr_ifrac,2), & + lbound(dataPtr_ifrac,3), ubound(dataPtr_ifrac,3) + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + dataPtr_ifrac = 0._ESMF_KIND_R8 + dataPtr_itemp = 0._ESMF_KIND_R8 +! dataPtr_mask = 0._ESMF_KIND_R8 + call ESMF_LogWrite(info, ESMF_LOGMSG_INFO, rc=dbrc) + do iblk = 1,nblocks + this_block = get_block(blocks_ice(iblk),iblk) + ilo = this_block%ilo + ihi = this_block%ihi + jlo = this_block%jlo + jhi = this_block%jhi + do j = jlo,jhi + do i = ilo,ihi + i1 = i - ilo + 1 + j1 = j - jlo + 1 +! if (hm(i,j,iblk) > 0.5) dataPtr_mask(i1,j1,iblk) = 1._ESMF_KIND_R8 + dataPtr_ifrac (i1,j1,iblk) = aice(i,j,iblk) ! ice fraction (0-1) + dataPtr_fhocn (i1,j1,iblk) = fhocn(i,j,iblk) ! heat exchange with ocean + dataPtr_fresh (i1,j1,iblk) = fresh(i,j,iblk) ! fresh water to ocean + dataPtr_fsalt (i1,j1,iblk) = fsalt(i,j,iblk) ! salt to ocean + dataPtr_vice (i1,j1,iblk) = vice(i,j,iblk) ! sea ice volume + dataPtr_vsno (i1,j1,iblk) = vsno(i,j,iblk) ! snow volume + dataPtr_fswthru (i1,j1,iblk) = fswthru(i,j,iblk) ! short wave penetration through ice + ui = strocnxT(i,j,iblk) + vj = strocnyT(i,j,iblk) + angT = ANGLET(i,j,iblk) + dataPtr_strocnxT(i1,j1,iblk) = ui*cos(-angT) + vj*sin(angT) ! ice ocean stress + dataPtr_strocnyT(i1,j1,iblk) = -ui*sin(angT) + vj*cos(-angT) ! ice ocean stress + enddo + enddo + enddo +! write(tmpstr,*) subname//' mask = ',minval(dataPtr_mask),maxval(dataPtr_mask) +! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) + + + + end subroutine + +end module cice_cap