wrfv2_fire/dyn_nmm/DSTRB.F

   1 !-----------------------------------------------------------------------
   2       SUBROUTINE DSTRB(ARRAYG,ARRAYL,LGS,LGE,LLS,LLE,L1                 &
   3      &,                IDS,IDE,JDS,JDE,KDS,KDE                          &
   4      &,                IMS,IME,JMS,JME,KMS,KME                          &
   5      &,                ITS,ITE,JTS,JTE,KTS,KTE)
   6 !-----------------------------------------------------------------------
   7 !     DSTRB DISTRIBUTES THE ELEMENTS OF REAL GLOBAL ARRAY ARRG TO THE
   8 !     REAL LOCAL ARRAYS ARRL.  LG IS THE VERTICAL DIMENSION OF THE
   9 !     GLOBAL ARRAY.  LL IS THE VERTICAL DIMENSION OF THE LOCAL ARRAY.
  10 !     L1 IS THE SPECIFIC LEVEL OF ARRL THAT IS BEING FILLED DURING
  11 !     THIS CALL (PERTINENT WHEN LG=1 AND LL>1).
  12 !-----------------------------------------------------------------------
  13       USE MODULE_EXT_INTERNAL
  14 !-----------------------------------------------------------------------
  15       IMPLICIT NONE
  16 !-----------------------------------------------------------------------
  17 #if defined(DM_PARALLEL) && !defined(STUBMPI)
  18       INCLUDE "mpif.h"
  19 #endif
  20 !-----------------------------------------------------------------------
  21 !***
  22 !***  ARGUMENT VARIABLES
  23 !***
  24       INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
  25      &,                     IMS,IME,JMS,JME,KMS,KME                     &
  26      &,                     ITS,ITE,JTS,JTE,KTS,KTE
  27       INTEGER,INTENT(IN) :: L1,LGE,LGS,LLE,LLS
  28 !
  29       REAL,DIMENSION(IDS:IDE,JDS:JDE,LGS:LGE),INTENT(IN) :: ARRAYG
  30       REAL,DIMENSION(IMS:IME,JMS:JME,LLS:LLE),INTENT(OUT) :: ARRAYL
  31 !-----------------------------------------------------------------------
  32 !***
  33 !***  LOCAL VARIABLES
  34 !***
  35 #if defined(DM_PARALLEL) && !defined(STUBMPI)
  36       REAL,ALLOCATABLE,DIMENSION(:) :: ARRAYX
  37 !
  38       INTEGER :: I,IEND,IPE,IRECV,IRTN,ISEND,ISTART,J,JEND,JSTART,KNT   &
  39      &,          L,MPI_COMM_COMP,NUMVALS,MYPE,NPES
  40       INTEGER,DIMENSION(4) :: LIMITS
  41       INTEGER,DIMENSION(MPI_STATUS_SIZE) :: ISTAT
  42 #else
  43       INTEGER :: I,L,J
  44 #endif
  45 !-----------------------------------------------------------------------
  46 !***********************************************************************
  47 !-----------------------------------------------------------------------
  48 #if defined(DM_PARALLEL) && !defined(STUBMPI)
  49 !
  50 !***  GET OUR TASK ID AND THE COMMUNICATOR
  51 !
  52       CALL WRF_GET_MYPROC(MYPE)
  53       CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
  54       CALL WRF_GET_NPROC(NPES)
  55 !
  56 !***  INITIALIZE THE OUTPUT ARRAY
  57 !
  58       DO L=LLS,LLE
  59       DO J=JMS,JME
  60       DO I=IMS,IME
  61         ARRAYL(I,J,L)=0.
  62       ENDDO
  63       ENDDO
  64       ENDDO
  65 !
  66 !-----------------------------------------------------------------------
  67 !***  TASK 0 FILLS ITS OWN LOCAL DOMAIN THEN PARCELS OUT ALL THE OTHER
  68 !***  PIECES TO THE OTHER TASKS.
  69 !-----------------------------------------------------------------------
  70 !
  71       tasks : IF(MYPE==0)THEN
  72 !
  73         IF(LGE==LGS)THEN
  74           DO J=JTS,JTE
  75           DO I=ITS,ITE
  76             ARRAYL(I,J,L1)=ARRAYG(I,J,LGS)
  77           ENDDO
  78           ENDDO
  79 !
  80         ELSE
  81 !
  82           DO L=LGS,LGE
  83             DO J=JTS,JTE
  84             DO I=ITS,ITE
  85               ARRAYL(I,J,L)=ARRAYG(I,J,L)
  86             ENDDO
  87             ENDDO
  88           ENDDO
  89         ENDIF
  90 !
  91 !***  TASK 0 NEEDS THE LIMITS FROM EACH OF THE OTHER TASKS AND THEN
  92 !***  SENDS OUT THE APPROPRIATE PIECE OF THE GLOBAL ARRAY.
  93 !
  94         DO IPE=1,NPES-1
  95 !
  96           CALL MPI_RECV(LIMITS,4,MPI_INTEGER,IPE,IPE,MPI_COMM_COMP      &
  97      &,                 ISTAT,IRECV)
  98           ISTART=LIMITS(1)
  99           IEND=LIMITS(2)
 100           JSTART=LIMITS(3)
 101           JEND=LIMITS(4)
 102 !
 103           NUMVALS=(IEND-ISTART+1)*(JEND-JSTART+1)*(LGE-LGS+1)
 104           ALLOCATE(ARRAYX(NUMVALS),STAT=I)
 105
 106           KNT=0
 107 !
 108           DO L=LGS,LGE
 109             DO J=JSTART,JEND
 110             DO I=ISTART,IEND
 111               KNT=KNT+1
 112               ARRAYX(KNT)=ARRAYG(I,J,L)
 113             ENDDO
 114             ENDDO
 115           ENDDO
 116 !
 117           CALL MPI_SEND(ARRAYX,KNT,MPI_REAL,IPE,IPE,MPI_COMM_COMP,ISEND)
 118 !
 119           DEALLOCATE(ARRAYX)
 120 !
 121         ENDDO
 122 !
 123 !-----------------------------------------------------------------------
 124 !***  ALL OTHER TASKS TELL TASK 0 WHAT THEIR HORIZONTAL LIMITS ARE AND
 125 !***  RECEIVE THEIR PIECE OF THE GLOBAL ARRAY FROM TASK 0.
 126 !-----------------------------------------------------------------------
 127 !
 128       ELSE
 129 !
 130         LIMITS(1)=ITS
 131         LIMITS(2)=ITE
 132         LIMITS(3)=JTS
 133         LIMITS(4)=JTE
 134 !
 135         CALL MPI_SEND(LIMITS,4,MPI_INTEGER,0,MYPE,MPI_COMM_COMP,ISEND)
 136 !
 137         NUMVALS=(ITE-ITS+1)*(JTE-JTS+1)*(LGE-LGS+1)
 138         ALLOCATE(ARRAYX(NUMVALS),STAT=I)
 139 !
 140         CALL MPI_RECV(ARRAYX,NUMVALS,MPI_REAL,0,MYPE,MPI_COMM_COMP      &
 141      &,               ISTAT,IRECV)
 142 !
 143         KNT=0
 144         IF(LGE==LGS)THEN
 145           DO J=JTS,JTE
 146           DO I=ITS,ITE
 147             KNT=KNT+1
 148             ARRAYL(I,J,L1)=ARRAYX(KNT)
 149           ENDDO
 150           ENDDO
 151         ELSE
 152           DO L=LGS,LGE
 153             DO J=JTS,JTE
 154             DO I=ITS,ITE
 155               KNT=KNT+1
 156               ARRAYL(I,J,L)=ARRAYX(KNT)
 157             ENDDO
 158             ENDDO
 159           ENDDO
 160         ENDIF
 161 !
 162         DEALLOCATE(ARRAYX)
 163 !
 164 !-----------------------------------------------------------------------
 165 !
 166       ENDIF tasks
 167 !
 168 !-----------------------------------------------------------------------
 169       CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
 170 !-----------------------------------------------------------------------
 171 !
 172 !
 173 !***  INITIALIZE THE OUTPUT ARRAY
 174 !
 175       ARRAYL=0.0
 176
 177       DO L=LGS,LGE
 178       DO J=JDS,JDE
 179       DO I=IDS,IDE
 180         ARRAYL(I,J,L)=ARRAYG(I,J,L)
 181       ENDDO
 182       ENDDO
 183       ENDDO
 184
 185 #endif
 186       END SUBROUTINE DSTRB
 187 !
 188 !-----------------------------------------------------------------------