wrfv2_fire/frame/module_dm_stubs.F

   1 !WRF:PACKAGE:NODM
   2 !
   3 MODULE module_dm
   4
   5   CONTAINS
   6    SUBROUTINE init_module_dm
   7    END SUBROUTINE init_module_dm
   8
   9    REAL FUNCTION wrf_dm_max_real ( inval )
  10       IMPLICIT NONE
  11       REAL inval
  12       wrf_dm_max_real = inval
  13    END FUNCTION wrf_dm_max_real
  14
  15    REAL FUNCTION wrf_dm_min_real ( inval )
  16       IMPLICIT NONE
  17       REAL inval
  18       wrf_dm_min_real = inval
  19    END FUNCTION wrf_dm_min_real
  20
  21    SUBROUTINE wrf_dm_min_reals ( inval, retval, n )
  22       IMPLICIT NONE
  23       INTEGER, INTENT(IN) :: n
  24       REAL, INTENT(IN) :: inval(:)
  25       REAL, INTENT(OUT) :: retval(:)
  26       retval(:) = inval(:)
  27    END SUBROUTINE wrf_dm_min_reals
  28
  29    REAL FUNCTION wrf_dm_sum_real ( inval )
  30       IMPLICIT NONE
  31       REAL inval
  32       wrf_dm_sum_real = inval
  33    END FUNCTION wrf_dm_sum_real
  34
  35    SUBROUTINE wrf_dm_sum_reals ( inval, retval )
  36       IMPLICIT NONE
  37       REAL, INTENT(IN) :: inval(:)
  38       REAL, INTENT(OUT) :: retval(:)
  39       retval(:) = inval(:)
  40    END SUBROUTINE wrf_dm_sum_reals
  41
  42    INTEGER FUNCTION wrf_dm_sum_integer ( inval )
  43       IMPLICIT NONE
  44       INTEGER inval
  45       wrf_dm_sum_integer = inval
  46    END FUNCTION wrf_dm_sum_integer
  47
  48    SUBROUTINE wrf_dm_maxval ( val, idex, jdex )
  49       IMPLICIT NONE
  50       REAL val
  51       INTEGER idex, jdex
  52       RETURN
  53    END SUBROUTINE wrf_dm_maxval
  54
  55   SUBROUTINE wrf_dm_minval ( val, idex, jdex )
  56      IMPLICIT NONE
  57      REAL val
  58      INTEGER idex, jdex
  59      RETURN
  60   END SUBROUTINE wrf_dm_minval
  61
  62 ! stub
  63    SUBROUTINE wrf_dm_move_nest ( parent, nest, dx, dy )
  64       USE module_domain
  65       TYPE (domain), INTENT(INOUT) :: parent, nest
  66       INTEGER, INTENT(IN)          :: dx,dy
  67       RETURN
  68    END SUBROUTINE wrf_dm_move_nest
  69
  70 END MODULE module_dm
  71
  72 !=========================================================================
  73
  74 ! These are stub functions that do the right thing (usually nothing)
  75 ! in case DM_PARALLEL is not compiled for.
  76 ! This file, src/module_dm_stubs.F is copied to src/module_dm.F  when
  77 ! the code is built.
  78 ! If, on the other hand, a DM package is specified, the module_dm.F
  79 ! provided with that package (e.g. RSL) is copied from /external/RSL/module_dm.F
  80 ! into src/module_dm.F.
  81 ! It is important to recognize this, because changes directly to src/module_dm.F
  82 ! will be lost!
  83
  84 LOGICAL FUNCTION wrf_dm_on_monitor()
  85   wrf_dm_on_monitor = .true.
  86 END FUNCTION wrf_dm_on_monitor
  87
  88 INTEGER FUNCTION wrf_dm_monitor_rank()
  89   wrf_dm_monitor_rank = 0
  90 END FUNCTION wrf_dm_monitor_rank
  91
  92 SUBROUTINE wrf_get_myproc( myproc )
  93   IMPLICIT NONE
  94   INTEGER myproc
  95   myproc = 0
  96   RETURN
  97 END SUBROUTINE wrf_get_myproc
  98
  99 SUBROUTINE wrf_get_nproc( nprocs )
 100   IMPLICIT NONE
 101   INTEGER nprocs
 102   nprocs = 1
 103   RETURN
 104 END SUBROUTINE wrf_get_nproc
 105
 106 SUBROUTINE wrf_get_nprocx( nprocs )
 107   IMPLICIT NONE
 108   INTEGER nprocs
 109   nprocs = 1
 110   RETURN
 111 END SUBROUTINE wrf_get_nprocx
 112
 113 SUBROUTINE wrf_get_nprocy( nprocs )
 114   IMPLICIT NONE
 115   INTEGER nprocs
 116   nprocs = 1
 117   RETURN
 118 END SUBROUTINE wrf_get_nprocy
 119
 120 SUBROUTINE wrf_dm_bcast_string ( buf , size )
 121   IMPLICIT NONE
 122   INTEGER size
 123   INTEGER BUF(*)
 124   RETURN
 125 END SUBROUTINE wrf_dm_bcast_string
 126
 127 SUBROUTINE wrf_dm_bcast_bytes ( buf , size )
 128   IMPLICIT NONE
 129   INTEGER size
 130   INTEGER BUF(*)
 131   RETURN
 132 END SUBROUTINE wrf_dm_bcast_bytes
 133
 134 SUBROUTINE wrf_dm_bcast_integer( BUF, N1 )
 135    IMPLICIT NONE
 136    INTEGER n1
 137    INTEGER  buf(*)
 138    RETURN
 139 END SUBROUTINE wrf_dm_bcast_integer
 140
 141 SUBROUTINE wrf_dm_bcast_real( BUF, N1 )
 142    IMPLICIT NONE
 143    INTEGER n1
 144    REAL  buf(*)
 145    RETURN
 146 END SUBROUTINE wrf_dm_bcast_real
 147
 148 SUBROUTINE wrf_dm_bcast_logical( BUF, N1 )
 149    IMPLICIT NONE
 150    INTEGER n1
 151    LOGICAL  buf(*)
 152    RETURN
 153 END SUBROUTINE wrf_dm_bcast_logical
 154
 155 SUBROUTINE wrf_dm_halo ( domdesc , comms , stencil_id )
 156    IMPLICIT NONE
 157    INTEGER domdesc , comms(*) , stencil_id
 158    RETURN
 159 END SUBROUTINE wrf_dm_halo
 160
 161 SUBROUTINE wrf_dm_boundary ( domdesc , comms , period_id , &
 162                              periodic_x , periodic_y )
 163    IMPLICIT NONE
 164    INTEGER domdesc , comms(*) , period_id
 165    LOGICAL , INTENT(IN)      :: periodic_x, periodic_y
 166    RETURN
 167 END SUBROUTINE wrf_dm_boundary
 168
 169 SUBROUTINE wrf_dm_xpose_z2x ( domdesc , comms , xpose_id  )
 170    IMPLICIT NONE
 171    INTEGER domdesc , comms(*), xpose_id
 172    RETURN
 173 END SUBROUTINE wrf_dm_xpose_z2x
 174 SUBROUTINE wrf_dm_xpose_x2y ( domdesc , comms , xpose_id  )
 175    IMPLICIT NONE
 176    INTEGER domdesc , comms(*), xpose_id
 177    RETURN
 178 END SUBROUTINE wrf_dm_xpose_x2y
 179 SUBROUTINE wrf_dm_xpose_y2z ( domdesc , comms , xpose_id  )
 180    IMPLICIT NONE
 181    INTEGER domdesc , comms(*), xpose_id
 182    RETURN
 183 END SUBROUTINE wrf_dm_xpose_y2z
 184
 185 SUBROUTINE wrf_dm_define_comms ( grid )
 186    USE module_domain
 187    IMPLICIT NONE
 188    TYPE(domain) , INTENT (INOUT) :: grid
 189    RETURN
 190 END SUBROUTINE wrf_dm_define_comms
 191
 192 SUBROUTINE wrf_get_dm_communicator ( communicator )
 193    IMPLICIT NONE
 194    INTEGER , INTENT(OUT) :: communicator
 195    communicator = 0
 196    RETURN
 197 END SUBROUTINE wrf_get_dm_communicator
 198
 199 SUBROUTINE wrf_get_dm_iocommunicator ( iocommunicator )
 200    IMPLICIT NONE
 201    INTEGER , INTENT(OUT) :: iocommunicator
 202    iocommunicator = 0
 203    RETURN
 204 END SUBROUTINE wrf_get_dm_iocommunicator
 205
 206 SUBROUTINE wrf_dm_shutdown
 207       RETURN
 208 END SUBROUTINE wrf_dm_shutdown
 209 SUBROUTINE wrf_abort
 210       STOP 'wrf_abort'
 211 END SUBROUTINE wrf_abort
 212
 213 SUBROUTINE wrf_patch_to_global_real (buf,globbuf,domdesc,ndim,&
 214                                        ids,ide,jds,jde,kds,kde,&
 215                                        ims,ime,jms,jme,kms,kme,&
 216                                        ips,ipe,jps,jpe,kps,kpe )
 217    IMPLICIT NONE
 218    INTEGER                             ids,ide,jds,jde,kds,kde,&
 219                                        ims,ime,jms,jme,kms,kme,&
 220                                        ips,ipe,jps,jpe,kps,kpe
 221    INTEGER fid,domdesc,ndim,glen(3),llen(3)
 222    REAL globbuf(*)
 223    REAL buf(*)
 224    RETURN
 225 END SUBROUTINE wrf_patch_to_global_real
 226
 227 SUBROUTINE wrf_global_to_patch_real (globbuf,buf,domdesc,ndim,&
 228                                        ids,ide,jds,jde,kds,kde,&
 229                                        ims,ime,jms,jme,kms,kme,&
 230                                        ips,ipe,jps,jpe,kps,kpe )
 231    IMPLICIT NONE
 232    INTEGER                             ids,ide,jds,jde,kds,kde,&
 233                                        ims,ime,jms,jme,kms,kme,&
 234                                        ips,ipe,jps,jpe,kps,kpe
 235    INTEGER fid,domdesc,ndim,glen(3),llen(3)
 236    REAL globbuf(*)
 237    REAL buf(*)
 238    RETURN
 239 END SUBROUTINE wrf_global_to_patch_real
 240
 241
 242 SUBROUTINE wrf_patch_to_global_double (buf,globbuf,domdesc,ndim,&
 243                                        ids,ide,jds,jde,kds,kde,&
 244                                        ims,ime,jms,jme,kms,kme,&
 245                                        ips,ipe,jps,jpe,kps,kpe )
 246    IMPLICIT NONE
 247    INTEGER                             ids,ide,jds,jde,kds,kde,&
 248                                        ims,ime,jms,jme,kms,kme,&
 249                                        ips,ipe,jps,jpe,kps,kpe
 250    INTEGER fid,domdesc,ndim,glen(3),llen(3)
 251    DOUBLE PRECISION globbuf(*)
 252    DOUBLE PRECISION buf(*)
 253    RETURN
 254 END SUBROUTINE wrf_patch_to_global_double
 255
 256 SUBROUTINE wrf_global_to_patch_double (globbuf,buf,domdesc,ndim,&
 257                                        ids,ide,jds,jde,kds,kde,&
 258                                        ims,ime,jms,jme,kms,kme,&
 259                                        ips,ipe,jps,jpe,kps,kpe )
 260    IMPLICIT NONE
 261    INTEGER                             ids,ide,jds,jde,kds,kde,&
 262                                        ims,ime,jms,jme,kms,kme,&
 263                                        ips,ipe,jps,jpe,kps,kpe
 264    INTEGER fid,domdesc,ndim,glen(3),llen(3)
 265    DOUBLE PRECISION globbuf(*)
 266    DOUBLE PRECISION buf(*)
 267    RETURN
 268 END SUBROUTINE wrf_global_to_patch_double
 269
 270 SUBROUTINE wrf_patch_to_global_integer (buf,globbuf,domdesc,ndim,&
 271                                        ids,ide,jds,jde,kds,kde,&
 272                                        ims,ime,jms,jme,kms,kme,&
 273                                        ips,ipe,jps,jpe,kps,kpe )
 274    IMPLICIT NONE
 275    INTEGER                             ids,ide,jds,jde,kds,kde,&
 276                                        ims,ime,jms,jme,kms,kme,&
 277                                        ips,ipe,jps,jpe,kps,kpe
 278    INTEGER fid,domdesc,ndim,glen(3),llen(3)
 279    INTEGER globbuf(*)
 280    INTEGER buf(*)
 281    RETURN
 282 END SUBROUTINE wrf_patch_to_global_integer
 283
 284 SUBROUTINE wrf_global_to_patch_integer (globbuf,buf,domdesc,ndim,&
 285                                        ids,ide,jds,jde,kds,kde,&
 286                                        ims,ime,jms,jme,kms,kme,&
 287                                        ips,ipe,jps,jpe,kps,kpe )
 288    IMPLICIT NONE
 289    INTEGER                             ids,ide,jds,jde,kds,kde,&
 290                                        ims,ime,jms,jme,kms,kme,&
 291                                        ips,ipe,jps,jpe,kps,kpe
 292    INTEGER fid,domdesc,ndim,glen(3),llen(3)
 293    INTEGER globbuf(*)
 294    INTEGER buf(*)
 295    RETURN
 296 END SUBROUTINE wrf_global_to_patch_integer
 297
 298 SUBROUTINE wrf_patch_to_global_logical (buf,globbuf,domdesc,ndim,&
 299                                        ids,ide,jds,jde,kds,kde,&
 300                                        ims,ime,jms,jme,kms,kme,&
 301                                        ips,ipe,jps,jpe,kps,kpe )
 302    IMPLICIT NONE
 303    INTEGER                             ids,ide,jds,jde,kds,kde,&
 304                                        ims,ime,jms,jme,kms,kme,&
 305                                        ips,ipe,jps,jpe,kps,kpe
 306    INTEGER fid,domdesc,ndim,glen(3),llen(3)
 307    LOGICAL globbuf(*)
 308    LOGICAL buf(*)
 309    RETURN
 310 END SUBROUTINE wrf_patch_to_global_logical
 311
 312 SUBROUTINE wrf_global_to_patch_LOGICAL (globbuf,buf,domdesc,ndim,&
 313                                        ids,ide,jds,jde,kds,kde,&
 314                                        ims,ime,jms,jme,kms,kme,&
 315                                        ips,ipe,jps,jpe,kps,kpe )
 316    IMPLICIT NONE
 317    INTEGER                             ids,ide,jds,jde,kds,kde,&
 318                                        ims,ime,jms,jme,kms,kme,&
 319                                        ips,ipe,jps,jpe,kps,kpe
 320    INTEGER fid,domdesc,ndim,glen(3),llen(3)
 321    LOGICAL globbuf(*)
 322    LOGICAL buf(*)
 323    RETURN
 324 END SUBROUTINE wrf_global_to_patch_LOGICAL
 325
 326