prism_dummy_mod.F90

Go to the documentation of this file.

!**** PRISM_DUMMY_MOD.F90
!
!     Purpose.
!     --------
!     Define interface and dummy routines needed to compile and link ifsMASTER 
!     with OASIS4 interfaces (ifs/prism/couplo4*) without linking 
!     to original prism libraries   
!
!     
!     Contains   
!     ----------
!     
!      MODULE PRISM_CONSTANTS 
!
!      MODULE PRISM_DUMMY 
!         INTERFACES for prism routines called in ifs/prism/couplo4* 
!
!      SUBROUTINES
!          prism_dummy_* referenced in PRISM_DUMMY    
!
!      Method
!      -------            
!      Provide interfaces with original prism rouinte names and refers to 
!        dummy subroutines named  prism_dummy_*  if original name is prism_*  
!
!      To run coupled runs with OASIS4 USE PRISM in ifs/prism/couplo4* instead !      of USE PRISM_DUMMY    
!          
!     Reference:
!     ---------
!       S. Valcke, 2006: OASIS4 User Guide  
!       PRISM Support Initiative Report No 3,
!       CERFACS, Toulouse, France, 64 pp.
!
!     Author:
!     -------
!       Johannes Flemming 
!
!     Modifications.
!     --------------
!      F. Vana  05-Mar-2015  Support for single precision




!**************************************************************************

MODULE prism_dummy_mod

USE parkind1 , ONLY : jprd, jpim
USE yomprism
#ifdef SFX_MPI
USE mpl_module, ONLY : mpl_abort
#endif
IMPLICIT NONE
SAVE

INTERFACE prism_set_points
MODULE PROCEDURE prism_dummy_set_points_gridless,prism_dummy_set_points_3d_dble
END INTERFACE

INTERFACE prism_put
MODULE PROCEDURE prism_dummy_put
END INTERFACE 


INTERFACE prism_get
MODULE PROCEDURE prism_dummy_get
END INTERFACE 


INTERFACE prism_initialized
MODULE PROCEDURE prism_dummy_initialized
END INTERFACE

 
INTERFACE  prism_init 
MODULE PROCEDURE prism_dummy_init
END INTERFACE

INTERFACE prism_init_comp 
MODULE PROCEDURE prism_dummy_init_comp
END INTERFACE

INTERFACE   prism_enddef
MODULE PROCEDURE prism_dummy_enddef
END INTERFACE

INTERFACE prism_terminate
MODULE PROCEDURE prism_dummy_terminate
END INTERFACE

INTERFACE prism_get_localcomm
MODULE PROCEDURE prism_dummy_get_localcomm
END INTERFACE

INTERFACE  prism_def_var
MODULE PROCEDURE prism_dummy_def_var
END INTERFACE

INTERFACE prism_def_grid
MODULE PROCEDURE prism_dummy_def_grid
END INTERFACE


INTERFACE prism_def_partition
MODULE PROCEDURE prism_dummy_def_partition
END INTERFACE


INTERFACE prism_reducedgrid_map
MODULE PROCEDURE prism_dummy_reducedgrid_map
END INTERFACE

INTERFACE prism_set_corners
MODULE PROCEDURE prism_dummy_set_corners
END INTERFACE


INTERFACE prism_calc_newdate
MODULE PROCEDURE prism_dummy_calc_newdate
END INTERFACE




!**************************************************************************
CONTAINS

SUBROUTINE prism_dummy_set_points_gridless (METHOD_ID, POINT_NAME, GRID_ID, &
                                 &          NEW_POINTS, IERROR)
       CHARACTER (LEN=*), INTENT(IN)                   :: POINT_NAME
       INTEGER(KIND=JPIM),           INTENT(IN)                   :: GRID_ID
       LOGICAL,           INTENT(IN)                   :: NEW_POINTS
       INTEGER(KIND=JPIM),           INTENT(INOUT)                :: METHOD_ID
       INTEGER(KIND=JPIM),           INTENT(OUT)                  :: IERROR
#ifdef SFX_MPI
       CALL mpl_abort('ABORT PRISM_DUMMY')
#endif

END SUBROUTINE prism_dummy_set_points_gridless

!**************************************************************************

SUBROUTINE  prism_dummy_set_points_3d_dble(METHOD_ID, POINT_NAME, GRID_ID, & 
                  &        POINTS_ACTUAL_SHAPE, POINTS_1ST_ARRAY, POINTS_2ND_ARRAY, & 
                  &        POINTS_3RD_ARRAY, NEW_POINTS, IERROR)
       CHARACTER (LEN=*), INTENT(IN)                   :: POINT_NAME
       INTEGER(KIND=JPIM),           INTENT(IN)                   :: GRID_ID
       INTEGER(KIND=JPIM),           INTENT(INOUT)                :: METHOD_ID
       REAL(KIND=JPRD),  INTENT(IN), DIMENSION (:)    :: POINTS_1ST_ARRAY, POINTS_2ND_ARRAY, POINTS_3RD_ARRAY
       INTEGER(KIND=JPIM),           INTENT(IN)                   :: POINTS_ACTUAL_SHAPE (2, *)
       LOGICAL,           INTENT(IN)                   :: NEW_POINTS
       INTEGER(KIND=JPIM),           INTENT(OUT)                  :: IERROR

       CALL mpl_abort('ABORT PRISM_DUMMY')

END SUBROUTINE prism_dummy_set_points_3d_dble

!**************************************************************************

SUBROUTINE prism_dummy_init ( APPL_NAME, IERROR )
       CHARACTER (LEN=*), INTENT(IN) :: APPL_NAME
       INTEGER(KIND=JPIM), INTENT (OUT)         :: IERROR

        stop 'ABORT PRISM_DUMMY'

END SUBROUTINE prism_dummy_init

!**************************************************************************

SUBROUTINE prism_dummy_init_comp ( COMP_ID, COMP_NAME, IERROR )  
       CHARACTER (LEN=*), INTENT(IN) :: COMP_NAME
       INTEGER(KIND=JPIM), INTENT (OUT) :: COMP_ID, IERROR

       CALL mpl_abort('ABORT PRISM_DUMMY')

END SUBROUTINE prism_dummy_init_comp

!**************************************************************************

SUBROUTINE prism_dummy_enddef ( IERROR )
       INTEGER(KIND=JPIM), INTENT (OUT) :: IERROR

       CALL mpl_abort('ABORT PRISM_DUMMY')

END SUBROUTINE prism_dummy_enddef

!**************************************************************************

SUBROUTINE prism_dummy_terminate ( IERROR )
      INTEGER(KIND=JPIM), INTENT (OUT) :: IERROR

      CALL mpl_abort('ABORT PRISM_DUMMY')

END SUBROUTINE prism_dummy_terminate

!**************************************************************************

SUBROUTINE prism_dummy_get_localcomm ( COMP_ID, LOCAL_COMM, IERROR )
       INTEGER(KIND=JPIM), INTENT (IN)  :: COMP_ID
       INTEGER(KIND=JPIM), INTENT (OUT) :: LOCAL_COMM, IERROR

       CALL mpl_abort('ABORT PRISM_DUMMY')

END SUBROUTINE prism_dummy_get_localcomm

!**************************************************************************

SUBROUTINE prism_dummy_def_var (VAR_ID, NAME, GRID_ID, METHOD_ID, MASK_ID, &
                     &      VAR_NODIMS, VAR_ACTUAL_SHAPE, VAR_TYPE, IERROR )
       INTEGER(KIND=JPIM), INTENT(OUT)         :: VAR_ID
       CHARACTER (LEN=*), INTENT(IN) :: NAME
       INTEGER(KIND=JPIM), INTENT(IN)          :: GRID_ID
       INTEGER(KIND=JPIM), INTENT(IN)          :: METHOD_ID
       INTEGER(KIND=JPIM), INTENT(IN)          :: MASK_ID
       INTEGER(KIND=JPIM), INTENT(IN)          :: VAR_NODIMS(2)
       INTEGER(KIND=JPIM), INTENT(IN)          :: VAR_ACTUAL_SHAPE(1:2, 1:var_nodims(1)+var_nodims(2))
       INTEGER(KIND=JPIM), INTENT(IN)          :: VAR_TYPE
       INTEGER(KIND=JPIM), INTENT(OUT)         :: IERROR 

       CALL mpl_abort('ABORT PRISM_DUMMY')
     END SUBROUTINE prism_dummy_def_var

!**************************************************************************  

SUBROUTINE prism_dummy_def_grid ( GRID_ID, GRID_NAME, COMP_ID, GRID_VALID_SHAPE, &
                              &     GRID_TYPE, IERROR)
       CHARACTER(LEN=*), INTENT(IN) :: GRID_NAME
       INTEGER(KIND=JPIM), INTENT(IN)          :: COMP_ID
       INTEGER(KIND=JPIM), INTENT(IN)          :: GRID_VALID_SHAPE (2, *)
       INTEGER(KIND=JPIM), INTENT(IN)          :: GRID_TYPE
       INTEGER(KIND=JPIM), INTENT(OUT)         :: GRID_ID, IERROR

       CALL mpl_abort('ABORT PRISM_DUMMY')

END SUBROUTINE prism_dummy_def_grid

!**************************************************************************

SUBROUTINE prism_dummy_def_partition ( GRID_ID, NBR_BLOCKS, &
                      &           PARTITION_ARRAY, EXTENT_ARRAY, IERROR )
       INTEGER(KIND=JPIM), INTENT (IN)                :: GRID_ID
       INTEGER(KIND=JPIM), INTENT (IN)                :: NBR_BLOCKS
       INTEGER(KIND=JPIM), INTENT (IN)                :: PARTITION_ARRAY(1:nbr_blocks,*)
       INTEGER(KIND=JPIM), INTENT (IN)                :: EXTENT_ARRAY(1:nbr_blocks,*)
       INTEGER(KIND=JPIM), INTENT (OUT)               :: IERROR

       CALL mpl_abort('ABORT PRISM_DUMMY')

END SUBROUTINE prism_dummy_def_partition

!**************************************************************************

SUBROUTINE prism_dummy_reducedgrid_map( GRID_ID,  NBR_LATITUDES, &
             &    NBR_POINTS_PER_LAT, IERROR )
       INTEGER(KIND=JPIM), INTENT (IN)                :: GRID_ID
       INTEGER(KIND=JPIM), INTENT (IN)                :: NBR_LATITUDES
       INTEGER(KIND=JPIM), INTENT (IN)                :: NBR_POINTS_PER_LAT(nbr_latitudes)
       INTEGER(KIND=JPIM), INTENT (OUT)               :: IERROR

       CALL mpl_abort('ABORT PRISM_DUMMY')

END SUBROUTINE prism_dummy_reducedgrid_map

!**************************************************************************

SUBROUTINE prism_dummy_set_corners(GRID_ID, NBR_CORNERS, CORNERS_ACTUAL_SHAPE, &
        &    CORNERS_1ST_ARRAY, CORNERS_2ND_ARRAY, CORNERS_3RD_ARRAY, IERROR)
       INTEGER(KIND=JPIM), INTENT (IN)                :: GRID_ID
       INTEGER(KIND=JPIM), INTENT (IN)                :: NBR_CORNERS
       REAL(KIND=JPRD), INTENT (IN)       :: CORNERS_1ST_ARRAY (:,:)
       REAL(KIND=JPRD), INTENT (IN)       :: CORNERS_2ND_ARRAY (:,:)
       REAL(KIND=JPRD), INTENT (IN)       :: CORNERS_3RD_ARRAY (:,:)
       INTEGER(KIND=JPIM), INTENT (IN)                :: CORNERS_ACTUAL_SHAPE (1:2, *)
       INTEGER(KIND=JPIM), INTENT(OUT)                :: IERROR

       CALL mpl_abort('ABORT PRISM_DUMMY')
END SUBROUTINE prism_dummy_set_corners

!**************************************************************************

SUBROUTINE prism_dummy_calc_newdate ( DATE, DATE_INCR, IERROR )
       REAL(KIND=JPRD), INTENT(IN)                     :: DATE_INCR
       type(prism_time_struct), INTENT(INOUT) :: date
       INTEGER(KIND=JPIM), INTENT(OUT)                    :: IERROR

       CALL mpl_abort('ABORT PRISM_DUMMY')
END SUBROUTINE prism_dummy_calc_newdate

!**************************************************************************

SUBROUTINE prism_dummy_put ( FIELD_ID, DATE, DATE_BOUNDS, DATA_ARRAY, INFO, IERROR )
      INTEGER(KIND=JPIM), INTENT (IN)                 :: FIELD_ID
      TYPE(prism_time_struct), INTENT (IN) :: DATE
      TYPE(prism_time_struct), INTENT (IN) :: DATE_BOUNDS(2)
      DOUBLE PRECISION, INTENT (IN)        :: DATA_ARRAY(:,:)
      INTEGER(KIND=JPIM), INTENT (OUT)               :: INFO
      INTEGER(KIND=JPIM), INTENT (OUT)               :: IERROR

      CALL mpl_abort('ABORT PRISM_DUMMY')

END   SUBROUTINE prism_dummy_put

!**************************************************************************

SUBROUTINE prism_dummy_get ( FIELD_ID, DATE, DATE_BOUNDS, DATA_ARRAY, INFO, IERROR )
      INTEGER(KIND=JPIM), INTENT (IN)                 :: FIELD_ID
      TYPE(prism_time_struct), INTENT (IN) :: DATE
      TYPE(prism_time_struct), INTENT (IN) :: DATE_BOUNDS(2)
      DOUBLE PRECISION, INTENT (OUT)        :: DATA_ARRAY(:,:)
      INTEGER(KIND=JPIM), INTENT (OUT)               :: INFO
      INTEGER(KIND=JPIM), INTENT (OUT)               :: IERROR

       CALL mpl_abort('ABORT PRISM_DUMMY')
END   SUBROUTINE prism_dummy_get

!**************************************************************************

SUBROUTINE prism_dummy_initialized ( FLAG, IERROR )
       LOGICAL, INTENT (OUT) :: FLAG
       INTEGER(KIND=JPIM), INTENT (OUT) :: IERROR
      
        CALL mpl_abort('ABORT PRISM_DUMMY')
END SUBROUTINE prism_dummy_initialized
END MODULE prism_dummy_mod