external/atm_ocn/module_PATCH_QUILT.F

   1 !-----------------------------------------------------------------------
   2 !
   3 !NCEP_MESO:MODEL_LAYER: SOLVER
   4 !
   5 !-----------------------------------------------------------------------
   6 !
   7       MODULE MODULE_PATCH_QUILT
   8 !
   9 !-----------------------------------------------------------------------
  10       USE MODULE_EXT_INTERNAL
  11 !-----------------------------------------------------------------------
  12 !
  13       PRIVATE
  14       PUBLIC :: PATCH,QUILT_2,QUILT_2_R8
  15 !
  16 !-----------------------------------------------------------------------
  17 !
  18       CONTAINS
  19 !
  20 !-----------------------------------------------------------------------
  21 !***********************************************************************
  22 !-----------------------------------------------------------------------
  23       SUBROUTINE PATCH(ARRAYG,ARRAYL                                    &
  24      &,                IDS,IDE,JDS,JDE,KDS,KDE                          &
  25      &,                IMS,IME,JMS,JME,KMS,KME                          &
  26      &,                ITS,ITE,JTS,JTE,KTS,KTE)
  27 !-----------------------------------------------------------------------
  28 !     PATCH DISTRIBUTES THE ELEMENTS OF REAL GLOBAL 2-D ARRAY ARRAYG TO
  29 !     THE REAL LOCAL 2-D ARRAY ARRAYL.
  30 !
  31 !     AUTHOR: TOM BLACK
  32 !-----------------------------------------------------------------------
  33 !
  34       IMPLICIT NONE
  35 !
  36 !-----------------------------------------------------------------------
  37 !
  38       INCLUDE "mpif.h"
  39 !
  40 !-----------------------------------------------------------------------
  41 !***  ARGUMENT VARIABLES
  42 !-----------------------------------------------------------------------
  43 !
  44       INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
  45      &,                     IMS,IME,JMS,JME,KMS,KME                     &
  46      &,                     ITS,ITE,JTS,JTE,KTS,KTE
  47 !
  48       REAL,DIMENSION(IDS:IDE,JDS:JDE),INTENT(IN) :: ARRAYG
  49       REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: ARRAYL
  50 !
  51 !-----------------------------------------------------------------------
  52 !***  LOCAL VARIABLES
  53 !-----------------------------------------------------------------------
  54 !
  55       REAL,ALLOCATABLE,DIMENSION(:) :: ARRAYX
  56 !
  57       INTEGER :: I,IEND,IPE,IRECV,IRTN,ISEND,ISTART,J,JEND,JSTART,KNT   &
  58      &,          L,MPI_COMM_COMP,NUMVALS,MYPE,NPES
  59 !
  60       INTEGER,DIMENSION(4) :: LIMITS
  61 !
  62       INTEGER,DIMENSION(MPI_STATUS_SIZE) :: ISTAT
  63
  64 !    SUBROUTINE wrf_global_to_patch_real (globbuf,buf,domdesc,stagger,ordering,&
  65 !                                       DS1,DE1,DS2,DE2,DS3,DE3,&
  66 !                                       MS1,ME1,MS2,ME2,MS3,ME3,&
  67 !                                       PS1,PE1,PS2,PE2,PS3,PE3 )
  68 !       IMPLICIT NONE
  69 !       INTEGER                         DS1,DE1,DS2,DE2,DS3,DE3,&
  70 !                                       MS1,ME1,MS2,ME2,MS3,ME3,&
  71 !                                       PS1,PE1,PS2,PE2,PS3,PE3
  72 !       CHARACTER *(*) stagger,ordering
  73 !       INTEGER fid,domdesc
  74 !       REAL globbuf(*)
  75 !       REAL buf(*)
  76
  77       CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
  78
  79       DO J=JMS,JME
  80       DO I=IMS,IME
  81         ARRAYL(I,J)=0.
  82       ENDDO
  83       ENDDO
  84       CALL wrf_global_to_patch_real(                                    &
  85      &                      arrayg, arrayl, mpi_comm_comp, 'xy', 'xy'   &
  86      &,                     IDS,IDE,JDS,JDE,1,1                     &
  87      &,                     IMS,IME,JMS,JME,1,1                     &
  88      &,                     ITS,ITE,JTS,JTE,1,1                     )
  89       RETURN
  90
  91 !!-----------------------------------------------------------------------
  92 !!***********************************************************************
  93 !!-----------------------------------------------------------------------
  94 !!
  95 !!-----------------------------------------------------------------------
  96 !!***  GET OUR TASK ID AND THE COMMUNICATOR
  97 !!-----------------------------------------------------------------------
  98 !!
  99 !      CALL WRF_GET_MYPROC(MYPE)
 100 !      CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
 101 !      CALL WRF_GET_NPROC(NPES)
 102 !      allocate(requests(npes))
 103 !!
 104 !!-----------------------------------------------------------------------
 105 !!***  INITIALIZE THE OUTPUT ARRAY
 106 !!-----------------------------------------------------------------------
 107 !!
 108 !      DO J=JMS,JME
 109 !      DO I=IMS,IME
 110 !        ARRAYL(I,J)=0.
 111 !      ENDDO
 112 !      ENDDO
 113 !!
 114 !!-----------------------------------------------------------------------
 115 !!***  TASK 0 FILLS ITS OWN LOCAL DOMAIN THEN PARCELS OUT ALL THE OTHER
 116 !!***  PIECES TO THE OTHER TASKS.
 117 !!-----------------------------------------------------------------------
 118 !!
 119 !!-----------------------------------------------------------------------
 120 !      tasks : IF(MYPE==0)THEN
 121 !!-----------------------------------------------------------------------
 122 !!
 123 !        DO J=JTS,JTE
 124 !        DO I=ITS,ITE
 125 !          ARRAYL(I,J)=ARRAYG(I,J)
 126 !        ENDDO
 127 !        ENDDO
 128 !!
 129 !!-----------------------------------------------------------------------
 130 !!***  TASK 0 NEEDS THE LIMITS FROM EACH OF THE OTHER TASKS AND THEN
 131 !!***  SENDS OUT THE APPROPRIATE PIECE OF THE GLOBAL ARRAY.
 132 !!-----------------------------------------------------------------------
 133 !!
 134 !        DO IPE=1,NPES-1
 135 !!
 136 !          CALL MPI_RECV(LIMITS,4,MPI_INTEGER,IPE,IPE,MPI_COMM_COMP      &
 137 !      &                ,ISTAT,IRECV)
 138 !!
 139 !          ISTART=LIMITS(1)
 140 !          IEND=LIMITS(2)
 141 !          JSTART=LIMITS(3)
 142 !          JEND=LIMITS(4)
 143 !!
 144 !          NUMVALS=(IEND-ISTART+1)*(JEND-JSTART+1)
 145 !          ALLOCATE(ARRAYX(NUMVALS),STAT=I)
 146 !
 147 !          KNT=0
 148 !!
 149 !          DO J=JSTART,JEND
 150 !          DO I=ISTART,IEND
 151 !            KNT=KNT+1
 152 !            ARRAYX(KNT)=ARRAYG(I,J)
 153 !          ENDDO
 154 !          ENDDO
 155 !!
 156 !          CALL MPI_SEND(ARRAYX,KNT,MPI_REAL,IPE,IPE,MPI_COMM_COMP,ISEND)
 157 !!
 158 !          DEALLOCATE(ARRAYX)
 159 !!
 160 !        ENDDO
 161 !!
 162 !!-----------------------------------------------------------------------
 163 !!***  ALL OTHER TASKS TELL TASK 0 WHAT THEIR HORIZONTAL LIMITS ARE AND
 164 !!***  RECEIVE THEIR PIECE OF THE GLOBAL ARRAY FROM TASK 0.
 165 !!-----------------------------------------------------------------------
 166 !!
 167 !      ELSE
 168 !!
 169 !        LIMITS(1)=ITS
 170 !        LIMITS(2)=ITE
 171 !        LIMITS(3)=JTS
 172 !        LIMITS(4)=JTE
 173 !!
 174 !        CALL MPI_SEND(LIMITS,4,MPI_INTEGER,0,MYPE,MPI_COMM_COMP,ISEND)
 175 !!
 176 !        NUMVALS=(ITE-ITS+1)*(JTE-JTS+1)
 177 !        ALLOCATE(ARRAYX(NUMVALS),STAT=I)
 178 !!
 179 !        CALL MPI_RECV(ARRAYX,NUMVALS,MPI_REAL,0,MYPE,MPI_COMM_COMP      &
 180 !     &,               ISTAT,IRECV)
 181 !!
 182 !        KNT=0
 183 !!
 184 !        DO J=JTS,JTE
 185 !        DO I=ITS,ITE
 186 !          KNT=KNT+1
 187 !          ARRAYL(I,J)=ARRAYX(KNT)
 188 !        ENDDO
 189 !        ENDDO
 190 !!
 191 !        DEALLOCATE(ARRAYX)
 192 !!
 193 !!-----------------------------------------------------------------------
 194 !!
 195 !      ENDIF tasks
 196 !
 197 !-----------------------------------------------------------------------
 198 !     CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
 199 !-----------------------------------------------------------------------
 200 !
 201       END SUBROUTINE PATCH
 202 !
 203 !-----------------------------------------------------------------------
 204 !***********************************************************************
 205 !-----------------------------------------------------------------------
 206       SUBROUTINE QUILT_2(ARRAYL,ARRAYG                                  &
 207      &                  ,IDS,IDE,JDS,JDE,KDS,KDE                        &
 208      &                  ,IMS,IME,JMS,JME,KMS,KME                        &
 209      &                  ,ITS,ITE,JTS,JTE,KTS,KTE)
 210 !-----------------------------------------------------------------------
 211 !     QUILT_2 PULLS TOGETHER THE MPI TASKS' LOCAL ARRAYS ARRAYL AND
 212 !     THEN QUILTS THEM TOGETHER INTO A SINGLE GLOBAL ARRAY ARRAYG.
 213 !
 214 !     AUTHOR: TOM BLACK
 215 !-----------------------------------------------------------------------
 216 !
 217       IMPLICIT NONE
 218 !
 219 !-----------------------------------------------------------------------
 220 !
 221       INCLUDE "mpif.h"
 222 !
 223 !-----------------------------------------------------------------------
 224 !***  ARGUMENT VARIABLES
 225 !-----------------------------------------------------------------------
 226 !
 227       INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
 228      &,                     IMS,IME,JMS,JME,KMS,KME                     &
 229      &,                     ITS,ITE,JTS,JTE,KTS,KTE
 230 !
 231       REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN)  :: ARRAYL
 232       REAL,DIMENSION(IDS:IDE,JDS:JDE),INTENT(OUT) :: ARRAYG
 233 !
 234 !-----------------------------------------------------------------------
 235 !***  LOCAL VARIABLES
 236 !-----------------------------------------------------------------------
 237 !
 238       REAL,ALLOCATABLE,DIMENSION(:) :: ARRAYX
 239 !
 240       INTEGER :: I,IEND,IPE,IRECV,IRTN,ISEND,ISTART,J,JEND,JSTART,KNT   &
 241      &,          L,MPI_COMM_COMP,NUMVALS,MYPE,NPES
 242 !
 243       INTEGER,DIMENSION(4) :: LIMITS
 244 !
 245       INTEGER,DIMENSION(MPI_STATUS_SIZE) :: ISTAT
 246 !-----------------------------------------------------------------------
 247 !***********************************************************************
 248 !-----------------------------------------------------------------------
 249 !
 250 !-----------------------------------------------------------------------
 251 !***  GET OUR TASK ID AND THE COMMUNICATOR
 252 !-----------------------------------------------------------------------
 253 !
 254       CALL WRF_GET_MYPROC(MYPE)
 255       CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
 256       CALL WRF_GET_NPROC(NPES)
 257 !
 258 !-----------------------------------------------------------------------
 259 !***  INITIALIZE THE OUTPUT ARRAY
 260 !-----------------------------------------------------------------------
 261 !
 262       DO J=JDS,JDE
 263       DO I=IDS,IDE
 264         ARRAYG(I,J)=0.
 265       ENDDO
 266       ENDDO
 267
 268       CALL wrf_patch_to_global_real(                                 &
 269      &                      arrayl, arrayg, mpi_comm_comp, 'xy', 'xy'   &
 270      &,                     IDS,IDE,JDS,JDE,1,1                     &
 271      &,                     IMS,IME,JMS,JME,1,1                     &
 272      &,                     ITS,ITE,JTS,JTE,1,1                     )
 273
 274       RETURN
 275
 276 !!
 277 !!-----------------------------------------------------------------------
 278 !!***  TASK 0 FILLS ITS OWN PART OF THE GLOBAL FIRST.
 279 !!-----------------------------------------------------------------------
 280 !!
 281 !!-----------------------------------------------------------------------
 282 !      tasks : IF(MYPE==0)THEN
 283 !!-----------------------------------------------------------------------
 284 !!
 285 !        DO J=JTS,JTE
 286 !        DO I=ITS,ITE
 287 !          ARRAYG(I,J)=ARRAYL(I,J)
 288 !        ENDDO
 289 !        ENDDO
 290 !!
 291 !!-----------------------------------------------------------------------
 292 !!***  TASK 0 NEEDS THE LIMITS FROM EACH OF THE OTHER TASKS AND THEN
 293 !!***  PULLS IN THE APPROPRIATE PIECES FROM ALL OTHER TASKS.
 294 !!-----------------------------------------------------------------------
 295 !!
 296 !        DO IPE=1,NPES-1
 297 !!
 298 !          CALL MPI_RECV(LIMITS,4,MPI_INTEGER,IPE,IPE,MPI_COMM_COMP      &
 299 !      &                ,ISTAT,IRECV)
 300 !!
 301 !          ISTART=LIMITS(1)
 302 !          IEND=LIMITS(2)
 303 !          JSTART=LIMITS(3)
 304 !          JEND=LIMITS(4)
 305 !!
 306 !          NUMVALS=(IEND-ISTART+1)*(JEND-JSTART+1)
 307 !          ALLOCATE(ARRAYX(NUMVALS),STAT=I)
 308 !!
 309 !          CALL MPI_RECV(ARRAYX,NUMVALS,MPI_REAL,IPE,IPE,MPI_COMM_COMP   &
 310 !     &                 ,ISTAT,IRECV)
 311 !!
 312 !          KNT=0
 313 !!
 314 !          DO J=JSTART,JEND
 315 !          DO I=ISTART,IEND
 316 !            KNT=KNT+1
 317 !            ARRAYG(I,J)=ARRAYX(KNT)
 318 !          ENDDO
 319 !          ENDDO
 320 !!
 321 !          DEALLOCATE(ARRAYX)
 322 !!
 323 !        ENDDO
 324 !!
 325 !!-----------------------------------------------------------------------
 326 !!***  ALL OTHER TASKS TELL TASK 0 WHAT THEIR HORIZONTAL LIMITS ARE AND
 327 !!***  SEND THEIR LOCAL ARRAY TO TASK 0.
 328 !!-----------------------------------------------------------------------
 329 !!
 330 !      ELSE
 331 !!
 332 !        LIMITS(1)=ITS
 333 !        LIMITS(2)=ITE
 334 !        LIMITS(3)=JTS
 335 !        LIMITS(4)=JTE
 336 !!
 337 !        CALL MPI_SEND(LIMITS,4,MPI_INTEGER,0,MYPE,MPI_COMM_COMP,ISEND)
 338 !!
 339 !        NUMVALS=(ITE-ITS+1)*(JTE-JTS+1)
 340 !        ALLOCATE(ARRAYX(NUMVALS),STAT=I)
 341 !!
 342 !        KNT=0
 343 !!
 344 !        DO J=JTS,JTE
 345 !        DO I=ITS,ITE
 346 !          KNT=KNT+1
 347 !          ARRAYX(KNT)=ARRAYL(I,J)
 348 !        ENDDO
 349 !        ENDDO
 350 !!
 351 !        CALL MPI_SEND(ARRAYX,NUMVALS,MPI_REAL,0,MYPE,MPI_COMM_COMP      &
 352 !     &,               ISEND)
 353 !!
 354 !        DEALLOCATE(ARRAYX)
 355 !!
 356 !!-----------------------------------------------------------------------
 357 !!
 358 !      ENDIF tasks
 359 !
 360 !-----------------------------------------------------------------------
 361 !     CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
 362 !-----------------------------------------------------------------------
 363 !
 364       END SUBROUTINE QUILT_2
 365 !
 366 !-----------------------------------------------------------------------
 367       SUBROUTINE QUILT_2_R8(ARRAYL,ARRAYG                                  &
 368      &                  ,IDS,IDE,JDS,JDE,KDS,KDE                        &
 369      &                  ,IMS,IME,JMS,JME,KMS,KME                        &
 370      &                  ,ITS,ITE,JTS,JTE,KTS,KTE)
 371 !-----------------------------------------------------------------------
 372 !     QUILT_2 PULLS TOGETHER THE MPI TASKS' LOCAL ARRAYS ARRAYL AND
 373 !     THEN QUILTS THEM TOGETHER INTO A SINGLE GLOBAL ARRAY ARRAYG.
 374 !
 375 !     AUTHOR: TOM BLACK
 376 !-----------------------------------------------------------------------
 377 !
 378       IMPLICIT NONE
 379 !
 380 !-----------------------------------------------------------------------
 381 !
 382       INCLUDE "mpif.h"
 383 !
 384 !-----------------------------------------------------------------------
 385 !***  ARGUMENT VARIABLES
 386 !-----------------------------------------------------------------------
 387 !
 388       INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
 389      &,                     IMS,IME,JMS,JME,KMS,KME                     &
 390      &,                     ITS,ITE,JTS,JTE,KTS,KTE
 391 !
 392       REAL(kind=8),DIMENSION(IMS:IME,JMS:JME),INTENT(IN)  :: ARRAYL
 393       REAL(kind=8),DIMENSION(IDS:IDE,JDS:JDE),INTENT(OUT) :: ARRAYG
 394 !
 395 !-----------------------------------------------------------------------
 396 !***  LOCAL VARIABLES
 397 !-----------------------------------------------------------------------
 398 !
 399       REAL,ALLOCATABLE,DIMENSION(:) :: ARRAYX
 400 !
 401       INTEGER :: I,IEND,IPE,IRECV,IRTN,ISEND,ISTART,J,JEND,JSTART,KNT   &
 402      &,          L,MPI_COMM_COMP,NUMVALS,MYPE,NPES
 403 !
 404       INTEGER,DIMENSION(4) :: LIMITS
 405 !
 406       INTEGER,DIMENSION(MPI_STATUS_SIZE) :: ISTAT
 407 !-----------------------------------------------------------------------
 408 !***********************************************************************
 409 !-----------------------------------------------------------------------
 410 !
 411 !-----------------------------------------------------------------------
 412 !***  GET OUR TASK ID AND THE COMMUNICATOR
 413 !-----------------------------------------------------------------------
 414 !
 415       CALL WRF_GET_MYPROC(MYPE)
 416       CALL WRF_GET_DM_COMMUNICATOR(MPI_COMM_COMP)
 417       CALL WRF_GET_NPROC(NPES)
 418 !
 419 !-----------------------------------------------------------------------
 420 !***  INITIALIZE THE OUTPUT ARRAY
 421 !-----------------------------------------------------------------------
 422 !
 423       DO J=JDS,JDE
 424       DO I=IDS,IDE
 425         ARRAYG(I,J)=0.
 426       ENDDO
 427       ENDDO
 428
 429       CALL wrf_patch_to_global_double(                                 &
 430      &                      arrayl, arrayg, mpi_comm_comp, 'xy', 'xy'   &
 431      &,                     IDS,IDE,JDS,JDE,1,1                     &
 432      &,                     IMS,IME,JMS,JME,1,1                     &
 433      &,                     ITS,ITE,JTS,JTE,1,1                     )
 434
 435       RETURN
 436
 437 !!
 438 !!-----------------------------------------------------------------------
 439 !!***  TASK 0 FILLS ITS OWN PART OF THE GLOBAL FIRST.
 440 !!-----------------------------------------------------------------------
 441 !!
 442 !!-----------------------------------------------------------------------
 443 !      tasks : IF(MYPE==0)THEN
 444 !!-----------------------------------------------------------------------
 445 !!
 446 !        DO J=JTS,JTE
 447 !        DO I=ITS,ITE
 448 !          ARRAYG(I,J)=ARRAYL(I,J)
 449 !        ENDDO
 450 !        ENDDO
 451 !!
 452 !!-----------------------------------------------------------------------
 453 !!***  TASK 0 NEEDS THE LIMITS FROM EACH OF THE OTHER TASKS AND THEN
 454 !!***  PULLS IN THE APPROPRIATE PIECES FROM ALL OTHER TASKS.
 455 !!-----------------------------------------------------------------------
 456 !!
 457 !        DO IPE=1,NPES-1
 458 !!
 459 !          CALL MPI_RECV(LIMITS,4,MPI_INTEGER,IPE,IPE,MPI_COMM_COMP      &
 460 !      &                ,ISTAT,IRECV)
 461 !!
 462 !          ISTART=LIMITS(1)
 463 !          IEND=LIMITS(2)
 464 !          JSTART=LIMITS(3)
 465 !          JEND=LIMITS(4)
 466 !!
 467 !          NUMVALS=(IEND-ISTART+1)*(JEND-JSTART+1)
 468 !          ALLOCATE(ARRAYX(NUMVALS),STAT=I)
 469 !!
 470 !          CALL MPI_RECV(ARRAYX,NUMVALS,MPI_REAL,IPE,IPE,MPI_COMM_COMP   &
 471 !     &                 ,ISTAT,IRECV)
 472 !!
 473 !          KNT=0
 474 !!
 475 !          DO J=JSTART,JEND
 476 !          DO I=ISTART,IEND
 477 !            KNT=KNT+1
 478 !            ARRAYG(I,J)=ARRAYX(KNT)
 479 !          ENDDO
 480 !          ENDDO
 481 !!
 482 !          DEALLOCATE(ARRAYX)
 483 !!
 484 !        ENDDO
 485 !!
 486 !!-----------------------------------------------------------------------
 487 !!***  ALL OTHER TASKS TELL TASK 0 WHAT THEIR HORIZONTAL LIMITS ARE AND
 488 !!***  SEND THEIR LOCAL ARRAY TO TASK 0.
 489 !!-----------------------------------------------------------------------
 490 !!
 491 !      ELSE
 492 !!
 493 !        LIMITS(1)=ITS
 494 !        LIMITS(2)=ITE
 495 !        LIMITS(3)=JTS
 496 !        LIMITS(4)=JTE
 497 !!
 498 !        CALL MPI_SEND(LIMITS,4,MPI_INTEGER,0,MYPE,MPI_COMM_COMP,ISEND)
 499 !!
 500 !        NUMVALS=(ITE-ITS+1)*(JTE-JTS+1)
 501 !        ALLOCATE(ARRAYX(NUMVALS),STAT=I)
 502 !!
 503 !        KNT=0
 504 !!
 505 !        DO J=JTS,JTE
 506 !        DO I=ITS,ITE
 507 !          KNT=KNT+1
 508 !          ARRAYX(KNT)=ARRAYL(I,J)
 509 !        ENDDO
 510 !        ENDDO
 511 !!
 512 !        CALL MPI_SEND(ARRAYX,NUMVALS,MPI_REAL,0,MYPE,MPI_COMM_COMP      &
 513 !     &,               ISEND)
 514 !!
 515 !        DEALLOCATE(ARRAYX)
 516 !!
 517 !!-----------------------------------------------------------------------
 518 !!
 519 !      ENDIF tasks
 520 !
 521 !-----------------------------------------------------------------------
 522 !     CALL MPI_BARRIER(MPI_COMM_COMP,IRTN)
 523 !-----------------------------------------------------------------------
 524 !
 525       END SUBROUTINE QUILT_2_R8
 526 !
 527 !-----------------------------------------------------------------------
 528 !
 529       END MODULE MODULE_PATCH_QUILT
 530 !
 531 !-----------------------------------------------------------------------