wrfv2_fire/external/RSL/RSL/rsl_merge_f.F

   1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 C
   3 C                              COPYRIGHT
   4 C
   5 C     The following is a notice of limited availability of the code and
   6 C     Government license and disclaimer which must be included in the
   7 C     prologue of the code and in all source listings of the code.
   8 C
   9 C     Copyright notice
  10 C       (c) 1977  University of Chicago
  11 C
  12 C     Permission is hereby granted to use, reproduce, prepare
  13 C     derivative works, and to redistribute to others at no charge.  If
  14 C     you distribute a copy or copies of the Software, or you modify a
  15 C     copy or copies of the Software or any portion of it, thus forming
  16 C     a work based on the Software and make and/or distribute copies of
  17 C     such work, you must meet the following conditions:
  18 C
  19 C          a) If you make a copy of the Software (modified or verbatim)
  20 C             it must include the copyright notice and Government
  21 C             license and disclaimer.
  22 C
  23 C          b) You must cause the modified Software to carry prominent
  24 C             notices stating that you changed specified portions of
  25 C             the Software.
  26 C
  27 C     This software was authored by:
  28 C
  29 C     Argonne National Laboratory
  30 C     J. Michalakes: (630) 252-6646; email: michalak@mcs.anl.gov
  31 C     Mathematics and Computer Science Division
  32 C     Argonne National Laboratory, Argonne, IL  60439
  33 C
  34 C     ARGONNE NATIONAL LABORATORY (ANL), WITH FACILITIES IN THE STATES
  35 C     OF ILLINOIS AND IDAHO, IS OWNED BY THE UNITED STATES GOVERNMENT,
  36 C     AND OPERATED BY THE UNIVERSITY OF CHICAGO UNDER PROVISION OF A
  37 C     CONTRACT WITH THE DEPARTMENT OF ENERGY.
  38 C
  39 C                      GOVERNMENT LICENSE AND DISCLAIMER
  40 C
  41 C     This computer code material was prepared, in part, as an account
  42 C     of work sponsored by an agency of the United States Government.
  43 C     The Government is granted for itself and others acting on its
  44 C     behalf a paid-up, nonexclusive, irrevocable worldwide license in
  45 C     this data to reproduce, prepare derivative works, distribute
  46 C     copies to the public, perform publicly and display publicly, and
  47 C     to permit others to do so.  NEITHER THE UNITED STATES GOVERNMENT
  48 C     NOR ANY AGENCY THEREOF, NOR THE UNIVERSITY OF CHICAGO, NOR ANY OF
  49 C     THEIR EMPLOYEES, MAKES ANY WARRANTY, EXPRESS OR IMPLIED, OR
  50 C     ASSUMES ANY LEGAL LIABILITY OR RESPONSIBILITY FOR THE ACCURACY,
  51 C     COMPLETENESS, OR USEFULNESS OF ANY INFORMATION, APPARATUS,
  52 C     PRODUCT, OR PROCESS DISCLOSED, OR REPRESENTS THAT ITS USE WOULD
  53 C     NOT INFRINGE PRIVATELY OWNED RIGHTS.
  54 C
  55 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  56 C
  57
  58       subroutine rsl_merge_chld( pd, nd, msize, mf, pf, upf )
  59       call cwrap_fmerge( pd, nd, msize, mf, pf, upf )
  60       return
  61       end
  62
  63       subroutine rsl_f_merge_chld( pd, nd, msize, buf, mf, pf, upf )
  64       implicit none
  65       integer pd                ! parent domain
  66       integer nd                ! nested domain
  67       integer msize             ! message size (bytes)
  68       logical mf                ! packing  mask function
  69       integer pf                ! packing function
  70       integer upf               ! unpacking function
  71       real buf(*)
  72       include 'rsl.inc'
  73 c local variables
  74       integer retval, i, j, pig, pjg, nig, njg
  75       integer dum, n, cm, cn
  76
  77       call rsl_to_parent_info( pd, nd, msize,
  78      +                         i,j,nig,njg,cm,cn,pig,pjg,retval )
  79       do while ( retval .eq. 1 )
  80         if ( mf( pd, nd, i, j, nig, njg ) ) then
  81           dum = pf( pd, nd, i, j, nig, njg, cm, cn, buf, msize )
  82           call rsl_to_parent_msg( msize, buf )
  83         endif
  84         call rsl_to_parent_info( pd, nd, msize,
  85      +                           i,j,nig,njg,cm,cn,pig,pjg,retval )
  86       enddo
  87
  88       call rsl_merge_msgs
  89
  90       call rsl_from_child_info( i,j,pig,pjg,cm,cn,nig,njg,retval )
  91       do while ( retval .eq. 1 )
  92         call rsl_from_child_msg( msize, buf )
  93         dum = upf( pd, nd, i, j, pig, pjg, cm, cn, buf, msize )
  94         call rsl_from_child_info( i,j,pig,pjg,cm,cn,nig,njg,retval )
  95       enddo
  96
  97       return
  98       end
  99