diff --git a/.gitignore b/.gitignore index e9921f3..026e261 100644 --- a/.gitignore +++ b/.gitignore @@ -4,4 +4,5 @@ build_auscom* tags drivers/auscom/version.F90 ._* +*.swp diff --git a/drivers/auscom/CICE_InitMod.F90 b/drivers/auscom/CICE_InitMod.F90 index 372ed7d..5c13b23 100644 --- a/drivers/auscom/CICE_InitMod.F90 +++ b/drivers/auscom/CICE_InitMod.F90 @@ -125,9 +125,9 @@ subroutine cice_init(accessom2) call accessom2%init('cicexx', config_dir=trim(accessom2_config_dir)) ! Tell libaccessom2 about any global configs/state - call accessom2%set_cpl_field_counts(num_atm_to_ice_fields=n_a2i, & - num_ice_to_ocean_fields=n_i2o, & - num_ocean_to_ice_fields=n_o2i) + call accessom2%set_cpl_field_counts(num_atm_to_ice_fields=num_fields_from_atm, & + num_ice_to_ocean_fields=num_fields_to_ocn, & + num_ocean_to_ice_fields=num_fields_from_ocn) ! Synchronise accessom2 configuration between all models and PEs call accessom2%sync_config(coupler) diff --git a/drivers/auscom/cpl_forcing_handler.F90 b/drivers/auscom/cpl_forcing_handler.F90 index 8c64c21..61cd89f 100644 --- a/drivers/auscom/cpl_forcing_handler.F90 +++ b/drivers/auscom/cpl_forcing_handler.F90 @@ -11,12 +11,13 @@ module cpl_forcing_handler use ice_state, only : aice, trcr !ice concentration and tracers use ice_gather_scatter !gather and scatter routines... ! use ice_constants, only : gravit, Tocnfrz - use ice_constants + use ice_constants use ice_grid, only : tmask use ice_communicate, only : my_task, master_task use ice_ocean, only : cprho !20091118 use ice_shortwave, only : ocn_albedo2D + use ice_exit, only: abort_ice use cpl_parameters use cpl_netcdf_setup @@ -193,49 +194,67 @@ subroutine get_time0_i2o_fields(fname) implicit none -character*(*), intent(in) :: fname + character*(*), intent(in) :: fname - integer(kind=int_kind) :: ncid_i2o, jf - logical :: dbug + integer(kind=int_kind) :: ncid_i2o, i -dbug = .true. -if ( file_exist(fname) ) then + if ( file_exist(fname) ) then #if defined(DEBUG) - if (my_task == master_task) write(il_out,*) '(get_time0_i2o_fields) reading in i2o fields......' + if (my_task == master_task) write(il_out,*) '(get_time0_i2o_fields) reading in i2o fields......' #endif - call ice_open_nc(fname, ncid_i2o) - do jf = n_i2a + 1, jpfldout !2:14 - vwork(:, :, :) = 0.0 - call ice_read_nc(ncid_i2o, 1, cl_writ(jf) , vwork, dbug) - if (jf == n_i2a+1 ) iostrsu = vwork - if (jf == n_i2a+2 ) iostrsv = vwork - if (jf == n_i2a+3 ) iorain = vwork - if (jf == n_i2a+4 ) iosnow = vwork - if (jf == n_i2a+5 ) iostflx = vwork - if (jf == n_i2a+6 ) iohtflx = vwork - if (jf == n_i2a+7 ) ioswflx = vwork - if (jf == n_i2a+8 ) ioqflux = vwork - if (jf == n_i2a+9 ) ioshflx = vwork - if (jf == n_i2a+10) iolwflx = vwork - if (jf == n_i2a+11) iorunof = vwork - if (jf == n_i2a+12) iopress = vwork - if (jf == n_i2a+13) ioaice = vwork - !!! - if (jf == n_i2a+14) iomelt = vwork - if (jf == n_i2a+15) ioform = vwork - if (jf == n_i2a+16) iolicefw = vwork - if (jf == n_i2a+17) iolicefh = vwork - enddo - if (my_task == master_task) call ice_close_nc(ncid_i2o) + call ice_open_nc(fname, ncid_i2o) + do i=1, num_fields_from_ocn + vwork(:, :, :) = 0.0 + call ice_read_nc(ncid_i2o, 1, trim(fields_to_ocn(i)) , vwork, .true.) + + if (trim(fields_to_ocn(i)) == 'strsu_io') then + iostrsu = vwork + elseif (trim(fields_to_ocn(i)) == 'strsv_io') then + iostrsv = vwork + elseif (trim(fields_to_ocn(i)) == 'rain_io') then + iorain = vwork + elseif (trim(fields_to_ocn(i)) == 'snow_io') then + iosnow = vwork + elseif (trim(fields_to_ocn(i)) == 'stflx_io') then + iostflx = vwork + elseif (trim(fields_to_ocn(i)) == 'htflx_io') then + iohtflx = vwork + elseif (trim(fields_to_ocn(i)) == 'swflx_io') then + ioswflx = vwork + elseif (trim(fields_to_ocn(i)) == 'qflx_io') then + ioqflux = vwork + elseif (trim(fields_to_ocn(i)) == 'shflx_io') then + ioshflx = vwork + elseif (trim(fields_to_ocn(i)) == 'lwflx_io') then + iolwflx = vwork + elseif (trim(fields_to_ocn(i)) == 'runof_io') then + iorunof = vwork + elseif (trim(fields_to_ocn(i)) == 'press_io') then + iopress = vwork + elseif (trim(fields_to_ocn(i)) == 'aice_io') then + ioaice = vwork + elseif (trim(fields_to_ocn(i)) == 'melt_io') then + iomelt = vwork + elseif (trim(fields_to_ocn(i)) == 'form_io') then + ioform = vwork + elseif (trim(fields_to_ocn(i)) == 'licefw_io') then + iolicefw = vwork + elseif (trim(fields_to_ocn(i)) == 'licefh_io') then + iolicefh = vwork + else + call abort_ice('ice: bad initialization array name '//fields_to_ocn(i)) + endif + enddo + if (my_task == master_task) call ice_close_nc(ncid_i2o) + #if defined(DEBUG) - if (my_task == master_task) write(il_out,*) '(get_time0_i2o_fields) has read in 11 i2o fields.' + if (my_task == master_task) write(il_out,*) '(get_time0_i2o_fields) has read in 11 i2o fields.' #endif -else - print *, 'CICE: (get_time0_i2o_fields_old) not found file *** ',fname - stop 'CICE stopped -- Need time0 i2o data file.' -endif + else + print *, 'CICE: (get_time0_i2o_fields_old) not found file *** ',fname + stop 'CICE stopped -- Need time0 i2o data file.' + endif -return end subroutine get_time0_i2o_fields !=============================================================================== @@ -352,55 +371,72 @@ subroutine newt_forcing_raw end subroutine newt_forcing_raw !=============================================================================== -subroutine save_time0_i2o_fields(fname, nstep) +! output the last i2o forcing data, to be read in at the beginning of next run +! by cice and sent to ocn immediately -! --- output the last i2o forcing data, to be read in at the beginning of next run -! by cice and sent to ocn immediately +subroutine save_time0_i2o_fields(fname, nstep) implicit none -character*(*), intent(in) :: fname + character*(*), intent(in) :: fname integer(kind=int_kind), intent(in) :: nstep integer(kind=int_kind) :: ncid - integer(kind=int_kind) :: jf, ll, ilout + integer(kind=int_kind) :: i, ll, ilout + + if (my_task == 0) then + call create_ncfile(fname, ncid, nx_global, ny_global, ll=1, ilout=il_out) + call write_nc_1Dtime(real(nstep), 1, 'time', ncid) + endif + + do i=1, num_fields_from_ocn !2:13 + if (trim(fields_to_ocn(i)) == 'strsu_io') then + vwork = iostrsu + elseif (trim(fields_to_ocn(i)) == 'strsv_io') then + vwork = iostrsv + elseif (trim(fields_to_ocn(i)) == 'rain_io') then + vwork = iorain + elseif (trim(fields_to_ocn(i)) == 'snow_io') then + vwork = iosnow + elseif (trim(fields_to_ocn(i)) == 'stflx_io') then + vwork = iostflx + elseif (trim(fields_to_ocn(i)) == 'htflx_io') then + vwork = iohtflx + elseif (trim(fields_to_ocn(i)) == 'swflx_io') then + vwork = ioswflx + elseif (trim(fields_to_ocn(i)) == 'qflx_io') then + vwork = ioqflux + elseif (trim(fields_to_ocn(i)) == 'shflx_io') then + vwork = ioshflx + elseif (trim(fields_to_ocn(i)) == 'lwflx_io') then + vwork = iolwflx + elseif (trim(fields_to_ocn(i)) == 'runof_io') then + vwork = iorunof + elseif (trim(fields_to_ocn(i)) == 'press_io') then + vwork = iopress + elseif (trim(fields_to_ocn(i)) == 'aice_io') then + vwork = ioaice + elseif (trim(fields_to_ocn(i)) == 'melt_io') then + vwork = iomelt + elseif (trim(fields_to_ocn(i)) == 'form_io') then + vwork = ioform + elseif (trim(fields_to_ocn(i)) == 'licefw_io') then + vwork = iolicefw + elseif (trim(fields_to_ocn(i)) == 'licefh_io') then + vwork = iolicefh + else + call abort_ice('ice: bad initialization array name '//fields_to_ocn(i)) + endif + + call gather_global(gwork, vwork, master_task, distrb_info) + if (my_task == 0) then + call write_nc2D(ncid, fields_to_ocn(i), gwork, 2, nx_global, ny_global, 1, ilout=il_out) + endif + enddo + + if (my_task == 0) then + call ncheck(nf_close(ncid), 'save_time0_i2o_fields: nf_close') + endif -if (my_task == 0) then - call create_ncfile(fname, ncid, nx_global, ny_global, ll=1, ilout=il_out) - call write_nc_1Dtime(real(nstep), 1, 'time', ncid) -endif - -do jf = n_i2a + 1, jpfldout !2:13 - if (jf == n_i2a+1 ) vwork = iostrsu - if (jf == n_i2a+2 ) vwork = iostrsv - if (jf == n_i2a+3 ) vwork = iorain - if (jf == n_i2a+4 ) vwork = iosnow - if (jf == n_i2a+5 ) vwork = iostflx - if (jf == n_i2a+6 ) vwork = iohtflx - if (jf == n_i2a+7 ) vwork = ioswflx - if (jf == n_i2a+8 ) vwork = ioqflux - if (jf == n_i2a+9 ) vwork = ioshflx - if (jf == n_i2a+10) vwork = iolwflx - if (jf == n_i2a+11) vwork = iorunof - if (jf == n_i2a+12) vwork = iopress - if (jf == n_i2a+13) vwork = ioaice - !!! - if (jf == n_i2a+14 ) vwork = iomelt - if (jf == n_i2a+15 ) vwork = ioform - if (jf == n_i2a+16) vwork = iolicefw - if (jf == n_i2a+17) vwork = iolicefh - - call gather_global(gwork, vwork, master_task, distrb_info) - if (my_task == 0) then - call write_nc2D(ncid, cl_writ(jf), gwork, 2, nx_global, ny_global, 1, ilout=il_out) - endif - -enddo - -if (my_task == 0) then - call ncheck(nf_close(ncid), 'save_time0_i2o_fields: nf_close') -endif - -return end subroutine save_time0_i2o_fields !=============================================================================== diff --git a/drivers/auscom/cpl_interface.F90 b/drivers/auscom/cpl_interface.F90 index 5a3313d..cfeb6f8 100644 --- a/drivers/auscom/cpl_interface.F90 +++ b/drivers/auscom/cpl_interface.F90 @@ -68,8 +68,9 @@ module cpl_interface ! order according to ascending global_offset of segments. type(segment), dimension(:), allocatable :: part_def - integer(kind=int_kind), dimension(jpfldout) :: il_var_id_out ! ID for fields sent - integer(kind=int_kind), dimension(jpfldin) :: il_var_id_in ! ID for fields rcvd + integer(kind=int_kind), dimension(:), allocatable :: varid_fields_from_atm + integer(kind=int_kind), dimension(:), allocatable :: varid_fields_to_ocn + integer(kind=int_kind), dimension(:), allocatable :: varid_fields_from_ocn character(len=6), parameter :: cp_modnam='cicexx' ! Component model name integer, parameter :: ORANGE = 3 @@ -231,60 +232,29 @@ subroutine init_cpl(runtime_seconds, coupling_field_timesteps) ! Define name (as in namcouple) and declare each field sent by ice ! - !ice ==> atm - cl_writ(1)='isst_ia' - !ice ==> ocn - cl_writ(n_i2a+1 )='strsu_io' - cl_writ(n_i2a+2 )='strsv_io' - cl_writ(n_i2a+3 )='rain_io' - cl_writ(n_i2a+4 )='snow_io' - cl_writ(n_i2a+5 )='stflx_io' - cl_writ(n_i2a+6 )='htflx_io' - cl_writ(n_i2a+7 )='swflx_io' - cl_writ(n_i2a+8 )='qflux_io' - cl_writ(n_i2a+9 )='shflx_io' - cl_writ(n_i2a+10)='lwflx_io' - cl_writ(n_i2a+11)='runof_io' - cl_writ(n_i2a+12)='press_io' - cl_writ(n_i2a+13)='aice_io' - cl_writ(n_i2a+14)='melt_io' - cl_writ(n_i2a+15)='form_io' - cl_writ(n_i2a+16)='licefw_io' - cl_writ(n_i2a+17)='licefh_io' - - do jf=1, jpfldout - call oasis_def_var(il_var_id_out(jf),cl_writ(jf), part_id, & + allocate(varid_fields_to_ocn(num_fields_to_ocn)) + do i=1, num_fields_to_ocn + call oasis_def_var(varid_fields_to_ocn(i), trim(fields_to_ocn(i)), part_id, & il_var_nodims, PRISM_Out, il_var_shape, PRISM_Real, ierror) enddo + + ! ! Define name (as in namcouple) and declare each field received by ice ! - !atm ==> ice - cl_read(1) ='swfld_i' - cl_read(2) ='lwfld_i' - cl_read(3) ='rain_i' - cl_read(4) ='snow_i' - cl_read(5) ='press_i' - cl_read(6) ='runof_i' - cl_read(7) ='tair_i' - cl_read(8) ='qair_i' - cl_read(9) ='uwnd_i' - cl_read(10)='vwnd_i' - cl_read(11)='licalvf_i' - !ocn ==> ice - cl_read(n_a2i+1)='sst_i' - cl_read(n_a2i+2)='sss_i' - cl_read(n_a2i+3)='ssu_i' - cl_read(n_a2i+4)='ssv_i' - cl_read(n_a2i+5)='sslx_i' - cl_read(n_a2i+6)='ssly_i' - cl_read(n_a2i+7)='pfmice_i' - - do jf=1, jpfldin - call oasis_def_var(il_var_id_in(jf), cl_read(jf), part_id, & + allocate(varid_fields_from_atm(num_fields_from_atm)) + do i=1, num_fields_from_atm + call oasis_def_var(varid_fields_from_atm(i), trim(fields_from_atm(i)), part_id, & + il_var_nodims, PRISM_In, il_var_shape, PRISM_Real, ierror) + enddo + + allocate(varid_fields_from_ocn(num_fields_from_ocn)) + do i=1, num_fields_from_ocn + call oasis_def_var(varid_fields_from_ocn(i), trim(fields_from_ocn(i)), part_id, & il_var_nodims, PRISM_In, il_var_shape, PRISM_Real, ierror) enddo + ! ! 7- PSMILe end of declaration phase ! @@ -487,80 +457,84 @@ subroutine pack_coupling_array(input, output) endsubroutine pack_coupling_array subroutine from_atm(isteps) - integer(kind=int_kind), intent(in) :: isteps + integer(kind=int_kind), intent(in) :: isteps - integer(kind=int_kind) :: tag, request, info - integer(kind=int_kind) :: buf(1) - real(kind=dbl_kind), dimension(block_size_x*block_size_y*nblocks) :: work + integer :: i + integer(kind=int_kind) :: tag, request, info + integer(kind=int_kind) :: buf(1) + real(kind=dbl_kind), dimension(block_size_x*block_size_y*nblocks) :: work #if defined(DEBUG) write(il_out,*) '(from_atm) receiving coupling fields at rtime= ', isteps #endif - call ice_timer_start(timer_from_atm) - - call ice_timer_start(timer_waiting_atm) - call oasis_get(il_var_id_in(1), isteps, work, info) - call unpack_coupling_array(work, swflx0) - call ice_timer_stop(timer_waiting_atm) - - call oasis_get(il_var_id_in(2), isteps, work, info) - call unpack_coupling_array(work, lwflx0) - - call oasis_get(il_var_id_in(3), isteps, work, info) - call unpack_coupling_array(work, rain0) - - call oasis_get(il_var_id_in(4), isteps, work, info) - call unpack_coupling_array(work, snow0) - - call oasis_get(il_var_id_in(5), isteps, work, info) - call unpack_coupling_array(work, press0) - - call oasis_get(il_var_id_in(6), isteps, work, info) - call unpack_coupling_array(work, runof0) - - call oasis_get(il_var_id_in(7), isteps, work, info) - call unpack_coupling_array(work, tair0) - - call oasis_get(il_var_id_in(8), isteps, work, info) - call unpack_coupling_array(work, qair0) - - call oasis_get(il_var_id_in(9), isteps, work, info) - call unpack_coupling_array(work, uwnd0) - - call oasis_get(il_var_id_in(10), isteps, work, info) - call unpack_coupling_array(work, vwnd0) - - call oasis_get(il_var_id_in(11), isteps, work, info) - call unpack_coupling_array(work, calv0) + call ice_timer_start(timer_from_atm) + + do i=1, num_fields_from_atm + + if (i == 1) then + call ice_timer_start(timer_waiting_atm) + call oasis_get(varid_fields_from_atm(i), isteps, work, info) + call ice_timer_stop(timer_waiting_atm) + else + call oasis_get(varid_fields_from_atm(i), isteps, work, info) + endif + + if (trim(fields_from_atm(i)) == 'swfld_i') then + call unpack_coupling_array(work, swflx0) + elseif (trim(fields_from_atm(i)) == 'lwfld_i') then + call unpack_coupling_array(work, lwflx0) + elseif (trim(fields_from_atm(i)) == 'rain_i') then + call unpack_coupling_array(work, rain0) + elseif (trim(fields_from_atm(i)) == 'snow_i') then + call unpack_coupling_array(work, snow0) + elseif (trim(fields_from_atm(i)) == 'press_i') then + call unpack_coupling_array(work, press0) + elseif (trim(fields_from_atm(i)) == 'runof_i') then + call unpack_coupling_array(work, runof0) + elseif (trim(fields_from_atm(i)) == 'tair_i') then + call unpack_coupling_array(work, tair0) + elseif (trim(fields_from_atm(i)) == 'qair_i') then + call unpack_coupling_array(work, qair0) + elseif (trim(fields_from_atm(i)) == 'uwnd_i') then + call unpack_coupling_array(work, uwnd0) + elseif (trim(fields_from_atm(i)) == 'vwnd_i') then + call unpack_coupling_array(work, vwnd0) + elseif (trim(fields_from_atm(i)) == 'licalvf_i') then + call unpack_coupling_array(work, calv0) + else + call abort_ice('ice: bad coupling array name '//fields_from_atm(i)) + endif + enddo - ! need do t-grid to u-grid shift for vectors since all coupling occur on - ! t-grid points: <==No! actually CICE requires the input wind on T grid! - ! (see comment in code ice_flux.F) - !call t2ugrid(uwnd1) - !call t2ugrid(vwnd1) - ! ...and, as we use direct o-i communication and o-i share the same grid, - ! no need for any t2u and/or u2t shift before/after i-o coupling! + ! need do t-grid to u-grid shift for vectors since all coupling occur on + ! t-grid points: <==No! actually CICE requires the input wind on T grid! + ! (see comment in code ice_flux.F) + !call t3ugrid(uwnd1) + !call t2ugrid(vwnd1) + ! ...and, as we use direct o-i communication and o-i share the same grid, + ! no need for any t2u and/or u2t shift before/after i-o coupling! - if ( chk_a2i_fields ) then - call check_a2i_fields('fields_a2i_in_ice.nc',isteps) - endif + if ( chk_a2i_fields ) then + call check_a2i_fields('fields_a2i_in_ice.nc',isteps) + endif - ! Allow atm to progress. It is waiting on a receive. - if (my_task == master_task) then - request = MPI_REQUEST_NULL - tag = 5793 - call MPI_Isend(buf, 1, MPI_INTEGER, coupler%atm_root, tag, & - MPI_COMM_WORLD, request, ierror) - endif + ! Allow atm to progress. It is waiting on a receive. + if (my_task == master_task) then + request = MPI_REQUEST_NULL + tag = 5793 + call MPI_Isend(buf, 1, MPI_INTEGER, coupler%atm_root, tag, & + MPI_COMM_WORLD, request, ierror) + endif - call ice_timer_stop(timer_from_atm) + call ice_timer_stop(timer_from_atm) end subroutine from_atm subroutine from_ocn(isteps) integer(kind=int_kind), intent(in) :: isteps + integer :: i integer :: info real(kind=dbl_kind), dimension(block_size_x*block_size_y*nblocks) :: work @@ -569,29 +543,34 @@ subroutine from_ocn(isteps) #endif call ice_timer_start(timer_from_ocn) - call ice_timer_start(timer_waiting_ocn) - - call oasis_get(il_var_id_in(12), isteps, work, info) - call unpack_coupling_array(work, ssto) - call ice_timer_stop(timer_waiting_ocn) - - call oasis_get(il_var_id_in(13), isteps, work, info) - call unpack_coupling_array(work, ssso) - - call oasis_get(il_var_id_in(14), isteps, work, info) - call unpack_coupling_array(work, ssuo) - - call oasis_get(il_var_id_in(15), isteps, work, info) - call unpack_coupling_array(work, ssvo) - - call oasis_get(il_var_id_in(16), isteps, work, info) - call unpack_coupling_array(work, sslx) - call oasis_get(il_var_id_in(17), isteps, work, info) - call unpack_coupling_array(work, ssly) - - call oasis_get(il_var_id_in(18), isteps, work, info) - call unpack_coupling_array(work, pfmice) + do i=1, num_fields_from_ocn + if (i == 1) then + call ice_timer_start(timer_waiting_ocn) + call oasis_get(varid_fields_from_ocn(i), isteps, work, info) + call ice_timer_stop(timer_waiting_ocn) + else + call oasis_get(varid_fields_from_ocn(i), isteps, work, info) + endif + + if (trim(fields_from_ocn(i)) == 'sst_i') then + call unpack_coupling_array(work, ssto) + elseif (trim(fields_from_ocn(i)) == 'sss_i') then + call unpack_coupling_array(work, ssso) + elseif (trim(fields_from_ocn(i)) == 'ssu_i') then + call unpack_coupling_array(work, ssuo) + elseif (trim(fields_from_ocn(i)) == 'ssv_i') then + call unpack_coupling_array(work, ssvo) + elseif (trim(fields_from_ocn(i)) == 'sslx_i') then + call unpack_coupling_array(work, sslx) + elseif (trim(fields_from_ocn(i)) == 'ssly_i') then + call unpack_coupling_array(work, ssly) + elseif (trim(fields_from_ocn(i)) == 'pfmice_i') then + call unpack_coupling_array(work, pfmice) + else + call abort_ice('ice: bad coupling array name '//fields_from_ocn(i)) + endif + enddo if (chk_o2i_fields) then call check_o2i_fields('fields_o2i_in_ice.nc',isteps) @@ -612,58 +591,52 @@ subroutine into_ocn(isteps, scale) integer(kind=int_kind), intent(in) :: isteps real, intent(in) :: scale !only 1 or 1/coef_ic allowed! + integer :: i real(kind=dbl_kind), dimension(block_size_x*block_size_y*nblocks) :: work - call pack_coupling_array(iostrsu*scale, work) - call oasis_put(il_var_id_out(2), isteps, work, ierror) - - call pack_coupling_array(iostrsv*scale, work) - call oasis_put(il_var_id_out(3), isteps, work, ierror) - - call pack_coupling_array(iorain*scale, work) - call oasis_put(il_var_id_out(4), isteps, work, ierror) - - call pack_coupling_array(iosnow*scale, work) - call oasis_put(il_var_id_out(5), isteps, work, ierror) - - call pack_coupling_array(iostflx*scale, work) - call oasis_put(il_var_id_out(6), isteps, work, ierror) - - call pack_coupling_array(iohtflx*scale, work) - call oasis_put(il_var_id_out(7), isteps, work, ierror) - - call pack_coupling_array(ioswflx*scale, work) - call oasis_put(il_var_id_out(8), isteps, work, ierror) - - call pack_coupling_array(ioqflux*scale, work) - call oasis_put(il_var_id_out(9), isteps, work, ierror) - - call pack_coupling_array(ioshflx*scale, work) - call oasis_put(il_var_id_out(10), isteps, work, ierror) - - call pack_coupling_array(iolwflx*scale, work) - call oasis_put(il_var_id_out(11), isteps, work, ierror) - - call pack_coupling_array(iorunof*scale, work) - call oasis_put(il_var_id_out(12), isteps, work, ierror) - - call pack_coupling_array(iopress*scale, work) - call oasis_put(il_var_id_out(13), isteps, work, ierror) - - call pack_coupling_array(ioaice*scale, work) - call oasis_put(il_var_id_out(14), isteps, work, ierror) - - call pack_coupling_array(iomelt*scale, work) - call oasis_put(il_var_id_out(15), isteps, work, ierror) - - call pack_coupling_array(ioform*scale, work) - call oasis_put(il_var_id_out(16), isteps, work, ierror) - - call pack_coupling_array(iolicefw*scale, work) - call oasis_put(il_var_id_out(17), isteps, work, ierror) + do i=1, num_fields_to_ocn + + if (trim(fields_to_ocn(i)) == 'strsu_io') then + call pack_coupling_array(iostrsu*scale, work) + elseif (trim(fields_to_ocn(i)) == 'strsv_io') then + call pack_coupling_array(iostrsv*scale, work) + elseif (trim(fields_to_ocn(i)) == 'rain_io') then + call pack_coupling_array(iorain*scale, work) + elseif (trim(fields_to_ocn(i)) == 'snow_io') then + call pack_coupling_array(iosnow*scale, work) + elseif (trim(fields_to_ocn(i)) == 'stflx_io') then + call pack_coupling_array(iostflx*scale, work) + elseif (trim(fields_to_ocn(i)) == 'htflx_io') then + call pack_coupling_array(iohtflx*scale, work) + elseif (trim(fields_to_ocn(i)) == 'swflx_io') then + call pack_coupling_array(ioswflx*scale, work) + elseif (trim(fields_to_ocn(i)) == 'qflux_io') then + call pack_coupling_array(ioqflux*scale, work) + elseif (trim(fields_to_ocn(i)) == 'shflx_io') then + call pack_coupling_array(ioshflx*scale, work) + elseif (trim(fields_to_ocn(i)) == 'lwflx_io') then + call pack_coupling_array(iolwflx*scale, work) + elseif (trim(fields_to_ocn(i)) == 'runof_io') then + call pack_coupling_array(iorunof*scale, work) + elseif (trim(fields_to_ocn(i)) == 'press_io') then + call pack_coupling_array(iopress*scale, work) + elseif (trim(fields_to_ocn(i)) == 'aice_io') then + call pack_coupling_array(ioaice*scale, work) + elseif (trim(fields_to_ocn(i)) == 'melt_io') then + call pack_coupling_array(iomelt*scale, work) + elseif (trim(fields_to_ocn(i)) == 'form_io') then + call pack_coupling_array(ioform*scale, work) + elseif (trim(fields_to_ocn(i)) == 'licefw_io') then + call pack_coupling_array(iolicefw*scale, work) + elseif (trim(fields_to_ocn(i)) == 'licefh_io') then + call pack_coupling_array(iolicefh*scale, work) + else + call abort_ice('ice: bad coupling array name '//fields_to_ocn(i)) + endif + + call oasis_put(varid_fields_to_ocn(i), isteps, work, ierror) + enddo - call pack_coupling_array(iolicefh*scale, work) - call oasis_put(il_var_id_out(18), isteps, work, ierror) if (chk_i2o_fields) then call check_i2o_fields('fields_i2o_in_ice.nc',isteps, scale) diff --git a/drivers/auscom/cpl_parameters.F90 b/drivers/auscom/cpl_parameters.F90 index ffdf4db..dd2423c 100644 --- a/drivers/auscom/cpl_parameters.F90 +++ b/drivers/auscom/cpl_parameters.F90 @@ -6,118 +6,153 @@ module cpl_parameters implicit none - integer(kind=int_kind) :: nt_cells ! nx_global x ny_global - ! assigned in prism_init - integer(kind=int_kind), parameter :: jpfldout = 18 ! total number of fields sent - integer(kind=int_kind), parameter :: jpfldin = 18 ! total number of fields rcvd + integer(kind=int_kind) :: nt_cells ! nx_global x ny_global - integer(kind=int_kind), parameter :: n_a2i = 11 ! number of a2i fields - integer(kind=int_kind), parameter :: n_o2i = 7 ! number of o2i fields - integer(kind=int_kind), parameter :: n_i2a = 1 ! number of i2a fields - integer(kind=int_kind), parameter :: n_i2o = 17 ! number of i2o fields + integer, parameter :: MAX_COUPLING_FIELDS = 32 + character(len=16), dimension(MAX_COUPLING_FIELDS) :: fields_from_atm + character(len=16), dimension(MAX_COUPLING_FIELDS) :: fields_from_ocn + character(len=16), dimension(MAX_COUPLING_FIELDS) :: fields_to_ocn -! -character(len=16), dimension(jpfldout) :: cl_writ ! Symb names fields sent -character(len=16), dimension(jpfldin) :: cl_read ! Symb names fields rcvd - integer(kind=int_kind) :: il_out ! format io unit(s) for coupling cpu(s) -! - - integer(kind=int_kind) :: num_cpl_ai ! num of (a2i) cpl periods for this run - integer(kind=int_kind) :: num_cpl_io ! num of (i2o) cpl periods each atm_ice_timestep - integer(kind=int_kind) :: num_ice_io ! ice time loop iteration number per ice_ocean_timestep + integer :: num_fields_from_atm + integer :: num_fields_from_ocn + integer :: num_fields_to_ocn + + integer(kind=int_kind) :: il_out ! format io unit(s) for coupling cpu(s) + + integer(kind=int_kind) :: num_cpl_ai ! num of (a2i) cpl periods for this run + integer(kind=int_kind) :: num_cpl_io ! num of (i2o) cpl periods each atm_ice_timestep + integer(kind=int_kind) :: num_ice_io ! ice time loop iteration number per ice_ocean_timestep real(kind=dbl_kind) :: meltlimit = 50. !12/03/2008: set max melt real(kind=dbl_kind) :: ocn_albedo = 0.06 -logical :: & !pop_icediag is as that for ocn model, if true - pop_icediag = .false. , & ! ice formation from ocn is via POP approach - use_ocnslope = .false. , & !if .t. use the sea srf tilt passed from ocn - use_umask = .false. , & !if .t. use the pre-processed umask (be careful!) - ice_pressure_on = .true. , & - ice_fwflux = .false. , & - rotate_winds = .false. , & !.t. if oasis sends U,V as scalars. 20090319 - limit_icemelt = .false. , & !.f. no limit to ice melt . 20090320 - use_core_nyf_runoff = .false. , & !.t. use core Normal Year Forcing runoff data (remapped) 20090718 - use_core_iaf_runoff = .false. , & !.t. use core Inter-Annual Forcing runoff data (remapped) 20120302 - cst_ocn_albedo = .true. , & !.t. use constant ocean albedo (e.g., 0.06, to 0.1) - chk_frzmlt_sst = .false. , & ! otherwise use alfa = 0.069 - 0.011 cos(2phi) - chk_a2i_fields = .false. , & ! as in Large & Yeager (2009). - chk_i2a_fields = .false. , & - chk_i2o_fields = .false. , & - chk_o2i_fields = .false. , & - gfdl_surface_flux = .true., & !.t. use gfdl ocean surface flux calculation (dec2009) - chk_gfdl_roughness = .false., & !.t. output u_star & roughness once a cpl interval (jan2010) - debug_output = .false. + + logical :: & !pop_icediag is as that for ocn model, if true + pop_icediag = .false. , & ! ice formation from ocn is via POP approach + use_ocnslope = .false. , & !if .t. use the sea srf tilt passed from ocn + use_umask = .false. , & !if .t. use the pre-processed umask (be careful!) + ice_pressure_on = .true. , & + ice_fwflux = .false. , & + rotate_winds = .false. , & !.t. if oasis sends U,V as scalars. 20090319 + limit_icemelt = .false. , & !.f. no limit to ice melt . 20090320 + use_core_nyf_runoff = .false. , & !.t. use core Normal Year Forcing runoff data (remapped) 20090718 + use_core_iaf_runoff = .false. , & !.t. use core Inter-Annual Forcing runoff data (remapped) 20120302 + cst_ocn_albedo = .true. , & !.t. use constant ocean albedo (e.g., 0.06, to 0.1) + chk_frzmlt_sst = .false. , & ! otherwise use alfa = 0.069 - 0.011 cos(2phi) + chk_a2i_fields = .false. , & ! as in Large & Yeager (2009). + chk_i2a_fields = .false. , & + chk_i2o_fields = .false. , & + chk_o2i_fields = .false. , & + gfdl_surface_flux = .true., & !.t. use gfdl ocean surface flux calculation (dec2009) + chk_gfdl_roughness = .false., & !.t. output u_star & roughness once a cpl interval (jan2010) + debug_output = .false. real(kind=dbl_kind) :: precip_factor = 1.0 !test the precip (temporary use) character(len=1024) :: accessom2_config_dir = '../' -namelist/coupling_nml/ & - pop_icediag, & - use_ocnslope, & - use_umask, & - rotate_winds, & - ice_pressure_on, & - ice_fwflux, & - limit_icemelt, & - meltlimit, & - precip_factor, & - cst_ocn_albedo, & - ocn_albedo, & - gfdl_surface_flux, & - chk_gfdl_roughness, & - chk_frzmlt_sst, & - use_core_nyf_runoff, & - use_core_iaf_runoff, & - chk_a2i_fields, & - chk_i2a_fields, & - chk_i2o_fields, & - chk_o2i_fields, & - accessom2_config_dir, & - debug_output - - integer(kind=int_kind) :: iniday, inimon, iniyear !from inidate + namelist/coupling_nml/ & + pop_icediag, & + use_ocnslope, & + use_umask, & + rotate_winds, & + ice_pressure_on, & + ice_fwflux, & + limit_icemelt, & + meltlimit, & + precip_factor, & + cst_ocn_albedo, & + ocn_albedo, & + gfdl_surface_flux, & + chk_gfdl_roughness, & + chk_frzmlt_sst, & + use_core_nyf_runoff, & + use_core_iaf_runoff, & + chk_a2i_fields, & + chk_i2a_fields, & + chk_i2o_fields, & + chk_o2i_fields, & + accessom2_config_dir, & + debug_output, & + fields_from_atm, & + fields_to_ocn, & + fields_from_ocn + + integer(kind=int_kind) :: iniday, inimon, iniyear !from inidate real(kind=dbl_kind) :: coef_ic !dt_ice/dt_cpl_io, for i2o fields tavg real(kind=dbl_kind) :: frazil_factor = 0.5 - ! frazil_factor is associated with the difference between ocean - ! model and ice model time-stepping: for mom4, two-level frog-leap - ! is used and frazil heat flux is calculated and accumulated with - ! frazil_factor = 1, which is supposed to be used for a ice model - ! with the same two-level time-stepping scheme such as SIS. but - ! cice uses forward time-stepping, which means we need 'correct' - ! the received frazil energy by multiplying 0.5... + + ! frazil_factor is associated with the difference between ocean + ! model and ice model time-stepping: for mom4, two-level frog-leap + ! is used and frazil heat flux is calculated and accumulated with + ! frazil_factor = 1, which is supposed to be used for a ice model + ! with the same two-level time-stepping scheme such as SIS. but + ! cice uses forward time-stepping, which means we need 'correct' + ! the received frazil energy by multiplying 0.5... !--------------------------------------------------------------------------------------- contains subroutine read_namelist_parameters() -use ice_exit -use ice_fileunits + use ice_exit + use ice_fileunits - integer (int_kind) :: nml_error + integer (int_kind) :: nml_error, i -! all processors read the namelist-- + do i=1, MAX_COUPLING_FIELDS + fields_from_atm(i) = char(0) + fields_from_ocn(i) = char(0) + fields_to_ocn(i) = char(0) + enddo + ! all processors read the namelist call get_fileunit(nu_nml) -open(unit=nu_nml,file="input_ice.nml",form="formatted",status="old",iostat=nml_error) - -if (nml_error /= 0) then - nml_error = -1 -else - nml_error = 1 -endif -do while (nml_error > 0) - read(nu_nml, nml=coupling_nml,iostat=nml_error) - if (nml_error > 0) read(nu_nml,*) ! for Nagware compiler -end do -if (nml_error == 0) close(nu_nml) + open(unit=nu_nml,file="input_ice.nml",form="formatted",status="old",iostat=nml_error) + + if (nml_error /= 0) then + nml_error = -1 + else + nml_error = 1 + endif + do while (nml_error > 0) + read(nu_nml, nml=coupling_nml,iostat=nml_error) + if (nml_error > 0) read(nu_nml,*) ! for Nagware compiler + end do + if (nml_error == 0) close(nu_nml) call release_fileunit(nu_nml) -if (nml_error /= 0) then - call abort_ice('ice: error reading coupling_nml') -endif + if (nml_error /= 0) then + call abort_ice('ice: error reading coupling_nml') + endif + + num_fields_from_atm = 0 + do i=1, MAX_COUPLING_FIELDS + if (fields_from_atm(i) /= CHAR(0)) then + num_fields_from_atm = num_fields_from_atm + 1 + else + exit + endif + enddo + + num_fields_from_ocn = 0 + do i=1, MAX_COUPLING_FIELDS + if (fields_from_ocn(i) /= CHAR(0)) then + num_fields_from_ocn = num_fields_from_ocn + 1 + else + exit + endif + enddo + + num_fields_to_ocn = 0 + do i=1, MAX_COUPLING_FIELDS + if (fields_to_ocn(i) /= CHAR(0)) then + num_fields_to_ocn = num_fields_to_ocn + 1 + else + exit + endif + enddo + endsubroutine read_namelist_parameters