diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index b3c760c0fd..8e4dee42c8 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -6,26 +6,32 @@ module ocn_comp_mct ! !INTERFACE: ! !DESCRIPTION: -! This is the main driver for the MOM6 in CIME +! This is the main driver for MOM6 in CIME ! ! !REVISION HISTORY: ! ! !USES: - use esmf - use seq_cdata_mod - use mct_mod - use seq_infodata_mod, only: seq_infodata_type, & - seq_infodata_GetData, & - seq_infodata_start_type_start, & - seq_infodata_start_type_cont, & - seq_infodata_start_type_brnch + use esmf + use seq_cdata_mod + use mct_mod + use seq_flds_mod, only: seq_flds_x2o_fields, & + seq_flds_o2x_fields + use seq_infodata_mod, only: seq_infodata_type, & + seq_infodata_GetData, & + seq_infodata_start_type_start, & + seq_infodata_start_type_cont, & + seq_infodata_start_type_brnch + use seq_comm_mct, only: seq_comm_name, seq_comm_inst, seq_comm_suffix + use perf_mod, only: t_startf, t_stopf + ! From MOM6 - use ocean_model_mod, only: ocean_state_type, ocean_public_type - use ocean_model_mod, only: ocean_model_init - use MOM_time_manager, only: time_type, set_date, set_calendar_type, NOLEAP - use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here - use coupler_indices, only: coupler_indices_init + use ocean_model_mod, only: ocean_state_type, ocean_public_type + use ocean_model_mod, only: ocean_model_init + use MOM_time_manager, only: time_type, set_date, set_calendar_type, NOLEAP + use MOM_domains, only: MOM_infra_init, num_pes, root_pe, pe_here + use coupler_indices, only: coupler_indices_init + use ocn_import_export, only: SBUFF_SUM ! ! !PUBLIC MEMBER FUNCTIONS: @@ -43,13 +49,14 @@ module ocn_comp_mct ! !EOP ! !PRIVATE MODULE FUNCTIONS: + private :: ocn_SetGSMap_mct + private :: ocn_domain_mct -! ! !PRIVATE MODULE VARIABLES - type(ocean_state_type), pointer :: ocn_state => NULL() ! Private state of ocean - type(ocean_public_type), pointer :: ocn_surface => NULL() ! Public surface state of ocean + type(ocean_state_type), pointer :: ocn_state => NULL() ! Private state of ocean + type(ocean_public_type), pointer :: ocn_surface => NULL() ! Public surface state of ocean - type(seq_infodata_type), pointer :: & + type(seq_infodata_type), pointer :: & infodata !======================================================================= @@ -90,19 +97,69 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) character(len=384) :: runid character(len=384) :: runtype character(len=32) :: starttype ! infodata start type - integer :: mpicom + integer :: mpicom_ocn integer :: npes, pe0 integer :: i + integer :: lsize, nsend, nrecv + + ! mct variables (these are local for now) + integer :: MOM_MCT_ID + type(mct_gsMap), pointer :: MOM_MCT_gsMap ! 2d, points to cdata + type(mct_gGrid), pointer :: MOM_MCT_dom ! 2d, points to cdata + type(mct_gsMap) :: MOM_MCT_gsMap3d ! for 3d streams, local + type(mct_gGrid) :: MOM_MCT_dom3d ! for 3d streams, local + + ! instance control vars (these are local for now) + integer(kind=4) :: inst_index + character(len=16) :: inst_name + character(len=16) :: inst_suffix + + !!!DANGER!!!: change the following vars with the corresponding MOM6 vars + integer :: km=62 ! number of vertical levels +!----------------------------------------------------------------------- + + ! set (actually, get from mct) the cdata pointers: + call seq_cdata_setptrs(cdata_o, id=MOM_MCT_ID, mpicom=mpicom_ocn, infodata=infodata) - ! Initialize MOM6 - mpicom = cdata_o%mpicom - call MOM_infra_init(mpicom) + !--------------------------------------------------------------------- + ! Initialize the model run + !--------------------------------------------------------------------- + + call coupler_indices_init() + + call seq_infodata_GetData( infodata, case_name=runid ) + + call seq_infodata_GetData( infodata, start_type=starttype) + + if ( trim(starttype) == trim(seq_infodata_start_type_start)) then + runtype = "initial" + else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then + runtype = "continue" + else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then + runtype = "branch" + else + write(*,*) 'ocn_comp_mct ERROR: unknown starttype' + call exit(0) + end if + + ! instance control + + inst_name = seq_comm_name(MOM_MCT_ID) + inst_index = seq_comm_inst(MOM_MCT_ID) + inst_suffix = seq_comm_suffix(MOM_MCT_ID) + + !--------------------------------------------------------------------- + ! Initialize MOM6 + !--------------------------------------------------------------------- + + call t_startf('MOM_init') + + call MOM_infra_init(mpicom_ocn) call ESMF_ClockGet(EClock, currTime=current_time, rc=rc) call ESMF_TimeGet(current_time, yy=year, mm=month, dd=day, h=hour, m=minute, s=seconds, rc=rc) - ! we need to confirm this: - call set_calendar_type(NOLEAP) + call set_calendar_type(NOLEAP) !TODO: confirm this time_init = set_date(year, month, day, hour, minute, seconds, err_msg=errMsg) time_in = set_date(year, month, day, hour, minute, seconds, err_msg=errMsg) @@ -115,30 +172,59 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) allocate(ocn_surface%pelist(npes)) ocn_surface%pelist(:) = (/(i,i=pe0,pe0+npes)/) - ! initialize the model run + ! initialize the MOM6 model call ocean_model_init(ocn_surface, ocn_state, time_init, time_in) - ! set infodata, a cdata pointer - call seq_cdata_setptrs(cdata_o, infodata=infodata) + call t_stopf('MOM_init') + + !--------------------------------------------------------------------- + ! Initialize MCT attribute vectors and indices + !--------------------------------------------------------------------- + + call t_startf('MOM_mct_init') + + ! Set mct global seg maps: + + call ocn_SetGSMap_mct(mpicom_ocn, MOM_MCT_ID, MOM_MCT_GSMap, MOM_MCT_GSMap3d) + lsize = mct_gsMap_lsize(MOM_MCT_gsmap, mpicom_ocn) + + ! Initialize mct ocn domain (needs ocn initialization info) + + call ocn_domain_mct(lsize, MOM_MCT_gsmap, MOM_MCT_dom) + call ocn_domain_mct(lsize*km, MOM_MCT_gsmap3d, MOM_MCT_dom3d) + + ! Inialize mct attribute vectors + + ! Initialize the mct attribute vector x2o_o, given Attribute list and length: + call mct_aVect_init(x2o_o, rList=seq_flds_x2o_fields, lsize=lsize) + ! set the mct attribute vector x2o_o to zero: + call mct_aVect_zero(x2o_o) + + ! Initialize the mct attribute vector o2x_o, given Attribute list and length: + call mct_aVect_init(o2x_o, rList=seq_flds_o2x_fields, lsize=lsize) + ! set the mct attribute vector o2x_o to zero: + call mct_aVect_zero(o2x_o) + + nsend = mct_avect_nRattr(o2x_o) + nrecv = mct_avect_nRattr(x2o_o) + !allocate (SBUFF_SUM(nx_block,ny_block,max_blocks_clinic,nsend)) + + + + + + + + - ! initialize coupler indices - call coupler_indices_init() - ! get runid and starttype: - call seq_infodata_GetData( infodata, case_name=runid ) - call seq_infodata_GetData( infodata, start_type=starttype) - if ( trim(starttype) == trim(seq_infodata_start_type_start)) then - runtype = "initial" - else if (trim(starttype) == trim(seq_infodata_start_type_cont) ) then - runtype = "continue" - else if (trim(starttype) == trim(seq_infodata_start_type_brnch)) then - runtype = "branch" - else - write(*,*) 'ocn_comp_mct ERROR: unknown starttype' - call exit(0) - end if + + + + call t_stopf('MOM_mct_init') + !----------------------------------------------------------------------- @@ -209,6 +295,79 @@ subroutine ocn_final_mct( EClock, cdata_o, x2o_o, o2x_o) end subroutine ocn_final_mct +!*********************************************************************** +!BOP +!IROUTINE: ocn_SetGSMap_mct +! !INTERFACE: + + subroutine ocn_SetGSMap_mct(mpicom_ocn, MOM_MCT_ID, gsMap_ocn, gsMap3d_ocn) + +! !DESCRIPTION: +! This routine mct global seg maps for the MOM decomposition +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + implicit none + integer , intent(in) :: mpicom_ocn + integer , intent(in) :: MOM_MCT_ID + type(mct_gsMap), intent(inout) :: gsMap_ocn + type(mct_gsMap), intent(inout) :: gsMap3d_ocn + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + + +!----------------------------------------------------------------------- +!EOC + + end subroutine ocn_SetGSMap_mct + + +!*********************************************************************** +!BOP +! !IROUTINE: ocn_domain_mct +! !INTERFACE: + + subroutine ocn_domain_mct( lsize, gsMap_ocn, dom_ocn) + +! !DESCRIPTION: +! This routine mct global seg maps for the pop decomposition +! +! !REVISION HISTORY: +! same as module +! +! !INPUT/OUTPUT PARAMETERS: + + implicit none + integer , intent(in) :: lsize + type(mct_gsMap), intent(in) :: gsMap_ocn + type(mct_ggrid), intent(inout) :: dom_ocn + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + + +!----------------------------------------------------------------------- +!EOC + + end subroutine ocn_domain_mct + + end module ocn_comp_mct !||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| diff --git a/config_src/mct_driver/ocn_import_export.F90 b/config_src/mct_driver/ocn_import_export.F90 new file mode 100644 index 0000000000..6fd16835fb --- /dev/null +++ b/config_src/mct_driver/ocn_import_export.F90 @@ -0,0 +1,140 @@ +module ocn_import_export + + implicit none + public + save + + ! accumulated sum of send buffer quantities for averaging before being sent + !real (r8), dimension(:,:,:,:), allocatable :: SBUFF_SUM + !real (r8) :: tlast_coupled + + !TODO: update the types of following vars + double precision, dimension(:,:,:,:), allocatable :: SBUFF_SUM + double precision :: tlast_coupled +contains + +!*********************************************************************** +!BOP +! !IROUTINE: ocn_import +! !INTERFACE: + + subroutine ocn_import(x2o, ldiag_cpl, errorCode) + +! !DESCRIPTION: +!----------------------------------------------------------------------- +! This routine receives message from cpl7 driver +! +! The following fields are always received from the coupler: +! +! o taux -- zonal wind stress (taux) (W/m2 ) +! o tauy -- meridonal wind stress (tauy) (W/m2 ) +! o snow -- water flux due to snow (kg/m2/s) +! o rain -- water flux due to rain (kg/m2/s) +! o evap -- evaporation flux (kg/m2/s) +! o meltw -- snow melt flux (kg/m2/s) +! o salt -- salt (kg(salt)/m2/s) +! o swnet -- net short-wave heat flux (W/m2 ) +! o sen -- sensible heat flux (W/m2 ) +! o lwup -- longwave radiation (up) (W/m2 ) +! o lwdn -- longwave radiation (down) (W/m2 ) +! o melth -- heat flux from snow&ice melt (W/m2 ) +! o ifrac -- ice fraction +! o rofl -- river runoff flux (kg/m2/s) +! o rofi -- ice runoff flux (kg/m2/s) +! +! The following fields are sometimes received from the coupler, +! depending on model options: +! +! o pslv -- sea-level pressure (Pa) +! o duu10n -- 10m wind speed squared (m^2/s^2) +! o co2prog-- bottom atm level prognostic co2 +! o co2diag-- bottom atm level diagnostic co2 +! +!----------------------------------------------------------------------- +! +! !REVISION HISTORY: +! same as module + +! !INPUT/OUTPUT PARAMETERS: + + !real(r8) , intent(inout) :: x2o(:,:) + !logical (log_kind) , intent(in) :: ldiag_cpl + !integer (POP_i4) , intent(out) :: errorCode ! returned error code + + !TODO: update the types of following params + double precision, intent(inout) :: x2o(:,:) + logical, intent(in) :: ldiag_cpl + integer, intent(out) :: errorCode ! returned error code + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + + + + + + + + + +!----------------------------------------------------------------------- +!EOC + + end subroutine ocn_import + +!*********************************************************************** +!BOP +! !IROUTINE: ocn_export_mct +! !INTERFACE: + + subroutine ocn_export(o2x, ldiag_cpl, errorCode) + +! !DESCRIPTION: +! This routine calls the routines necessary to send MOM6 fields to +! the CCSM cpl7 driver +! +! !REVISION HISTORY: +! same as module +! +! !INPUT/OUTPUT PARAMETERS: + + !real(r8) , intent(inout) :: o2x(:,:) + !logical (log_kind) , intent(in) :: ldiag_cpl + !integer (POP_i4) , intent(out) :: errorCode ! returned error code + + !TODO: update the types of following params + double precision, intent(inout) :: o2x(:,:) + logical, intent(in) :: ldiag_cpl + integer, intent(out) :: errorCode ! returned error code + +!EOP +!BOC +!----------------------------------------------------------------------- +! +! local variables +! +!----------------------------------------------------------------------- + + + + + + + + +!----------------------------------------------------------------------- +!EOC + + end subroutine ocn_export + +!*********************************************************************** + + +end module ocn_import_export +