! OASIS-MCT calls for LPJ-GUESS. ! March 2015 - removed all old prism calls ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_init_comp_(int *, char *); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_init_comp(compid,model_name) use mod_oasis ! Arguments integer, intent(out) :: compid character(len=4),intent(in) :: model_name ! Locals integer :: ierror print*, "LPJ-GUESS - calling oasis_init_comp" call oasis_init_comp(compid,model_name,ierror) print*, "LPJ-GUESS - oasis_init_comp returned with ierror =",ierror print*, "LPJ-GUESS - oasis_init_comp returned compid = ",compid oasismct_init_comp = ierror return end function oasismct_init_comp ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_get_localcomm_(int *); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_get_localcomm(localcommid) use mod_oasis ! Arguments integer, intent(out) :: localcommid ! Locals integer :: ierror,lcid print*, "LPJ-GUESS - calling oasis_get_localcomm" call oasis_get_localcomm(lcid, ierror) print*, "LPJ-GUESS - oasis_get_localcomm returned ierror =",ierror print*, "LPJ-GUESS - localcomm = ",lcid localcommid = lcid oasismct_get_localcomm = ierror return end function oasismct_get_localcomm ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_create_couplcomm_(int, int, int *); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_create_couplcomm(myrank, loccommid, cplcommid) use mod_oasis use mpi ! Arguments integer, intent(in) :: myrank integer, intent(in) :: loccommid integer, intent(out) :: cplcommid ! Locals integer :: ierror integer :: icpl icpl = 1 if (myrank /= 0) icpl = MPI_UNDEFINED print*, "LPJ-GUESS - calling oasis_create_couplcomm with icpl = ",icpl call oasis_create_couplcomm(icpl, loccommid, cplcommid, ierror) print*, "LPJ-GUESS - oasis_create_couplcomm returned ierror =",ierror oasismct_create_couplcomm = ierror return end function oasismct_create_couplcomm ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_abort_(compid, routine_name, abort_message, return_code); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_abort(compid, routine_name, abort_message, return_code) use mod_oasis ! Arguments integer, intent(in) :: compid character(len=24),intent(in) :: routine_name character(len=50),intent(in) :: abort_message integer, intent(in) :: return_code ! Locals call oasis_abort(compid, routine_name, abort_message, return_code) oasismct_abort = 666 return end function oasismct_abort ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_terminate_(void); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_terminate() use mod_oasis ! Locals integer :: ierror call oasis_terminate(ierror) oasismct_terminate = ierror return end function oasismct_terminate ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_def_partition_(int *, int *, int *); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_def_partition(il_part_id,ig_paral,ig_paral_len) use mod_oasis ! use mod_oasis_def_partition ! Arguments integer,intent(out) :: il_part_id integer,intent(in) :: ig_paral_len integer,intent(in) :: ig_paral(ig_paral_len) ! Locals integer :: ierror print*, "LPJ-GUESS - oasis_def_partition with ig_paral(1)=",ig_paral(1) print*, "LPJ-GUESS - oasis_def_partition with ig_paral(2)=",ig_paral(2) print*, "LPJ-GUESS - oasis_def_partition with ig_paral(3)=",ig_paral(3) call oasis_def_partition(il_part_id,ig_paral,ierror) print*, "LPJ-GUESS - called oasis_def_partition with ierror =",ierror oasismct_def_partition = ierror return end function oasismct_def_partition ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_def_var_(int *, char *, int *, int *, int *, int *, int *); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_def_var(var_id,name,il_part_id,var_nodims,kinout,var_actual_shape,var_type) use mod_oasis ! Arguments integer, intent(out) :: var_id character(len=8),intent(in) :: name integer, intent(in) :: il_part_id integer, intent(in) :: var_nodims(2) integer, intent(in) :: kinout integer, intent(in) :: var_actual_shape(2*var_nodims(1)) integer, intent(in) :: var_type ! Locals integer :: ierror print*, "LPJ-GUESS - calling oasis_def_var for ",name call oasis_def_var(var_id,name,il_part_id,var_nodims,kinout,var_actual_shape,var_type,ierror) print*, "LPJ-GUESS - oasis_def_var returned ierror =",ierror oasismct_def_var = ierror return end function oasismct_def_var ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_enddef_(void); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_enddef() use mod_oasis ! Locals integer :: ierror print*, "LPJ-GUESS - calling oasis_enddef" call oasis_enddef(ierror) print*, "LPJ-GUESS - oasis_enddef returned ierror:",ierror oasismct_enddef = ierror return end function oasismct_enddef ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_put_1d_(int *, int *, double *, int *); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_put_1d(var_id,date,field_array,field_array_len) use mod_oasis ! Arguments integer, intent(in) :: var_id integer, intent(in) :: date integer, intent(in) :: field_array_len double precision,intent(in) :: field_array(field_array_len) ! Locals integer :: info call oasis_put(var_id,date,field_array,info) oasismct_put_1d = info return end function oasismct_put_1d ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_put_2d_(int *, int *, double *, int *, int *); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_put_2d(var_id,date,field_array,field_array_len_x,field_array_len_y) use mod_oasis ! Arguments integer, intent(in) :: var_id integer, intent(in) :: date integer, intent(in) :: field_array_len_x integer, intent(in) :: field_array_len_y double precision,intent(in) :: field_array(field_array_len_x,field_array_len_y) ! Locals integer :: info call oasis_put(var_id,date,field_array,info) oasismct_put_2d = info return end function oasismct_put_2d ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_get_1d_(int *, int *, double *, int *); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_get_1d(var_id,date,field_array,field_array_len) use mod_oasis ! Arguments integer, intent(in) :: var_id integer, intent(in) :: date integer, intent(in) :: field_array_len double precision,intent(out) :: field_array(field_array_len) ! Locals integer :: info call oasis_get(var_id,date,field_array,info) oasismct_get_1d = info return end function oasismct_get_1d ! ------------------------------------------------------------------------------------------------------ ! *** int oasismct_get_2d_(int *, int *, double *, int *); ! ------------------------------------------------------------------------------------------------------ integer function oasismct_get_2d(var_id,date,field_array,field_array_len_x,field_array_len_y) use mod_oasis ! Arguments integer, intent(in) :: var_id integer, intent(in) :: date integer, intent(in) :: field_array_len_x,field_array_len_y double precision,intent(out) :: field_array(field_array_len_x,field_array_len_y) ! Locals integer :: info call oasis_get(var_id,date,field_array,info) ! Outcomment some of these when debugging select case ( info ) case ( OASIS_Recvd ) print*, " received from other model" case ( OASIS_FromRest ) print*, " read from restart file (directly or via coupler)" case ( OASIS_Input ) print*, " read from input file" case ( OASIS_RecvOut ) print*, " received from other model (directly or via coupler) and written to output file" case ( OASIS_FromRestOut ) print*, " read from restart file (directly or via coupler) and written to output file" case ( OASIS_Ok ) print*, " no field received; continue" case default print*, "Error from oasismct_get_2d, oasis_get in LPJ-GUESS" end select oasismct_get_2d = info return end function oasismct_get_2d