frame/module_dm_stubs.F

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