image_calculator Subroutine

   SUBROUTINE image_calculator(image_dist, &
                               prow, rowi, pcol, coli, vprow, vpcol, &
                               myprow, mypcol, myrowi, mycoli, myvprow, myvpcol, &
                               vprow_shift, vpcol_shift, &
                               shifting)
      !! Transform between virtual process rows/columns and actual process rows/columns and images therein.
      !!
      !! Shifting
      !! (L)eft and (R)ight shifting are "shifts from", (l)eft and (r)ight
      !! are "shifts to".  A caller (or the my* specifications) would use
      !! L/R to see which data he has (i.e., from where his data was
      !! shifted).  To see where the caller's data goes to, use l/r.

      TYPE(dbcsr_imagedistribution_obj), INTENT(IN)      :: image_dist
      INTEGER, INTENT(OUT), OPTIONAL                     :: prow, rowi, pcol, coli, vprow, vpcol
      INTEGER, INTENT(IN), OPTIONAL                      :: myprow, mypcol, myrowi, mycoli, myvprow, &
                                                            myvpcol, vprow_shift, vpcol_shift
      CHARACTER, INTENT(IN), OPTIONAL                    :: shifting

      INTEGER                                            :: col_mult, my_pcol, my_prow, ncol_images, &
                                                            npcols, nprows, nrow_images, nvpcols, &
                                                            nvprows, row_mult, vcol, vrow
      TYPE(dbcsr_mp_obj)                                 :: mp

!   ---------------------------------------------------------------------------

      IF (careful_mod .AND. .NOT. PRESENT(myvprow) .AND. .NOT. PRESENT(mycoli)) THEN
         CALL dbcsr_abort(__LOCATION__, &
                          "Must specify either (process row and row image) or (virtual process row)")
      END IF
      IF (careful_mod .AND. .NOT. PRESENT(myvpcol) .AND. .NOT. PRESENT(mycoli)) THEN
         CALL dbcsr_abort(__LOCATION__, &
                          "Must specify either (process col and col image) or (virtual process col)")
      END IF
      !
      mp = image_dist%i%main%d%mp_env
      nprows = SIZE(mp%mp%pgrid, 1)
      npcols = SIZE(mp%mp%pgrid, 2)
      nrow_images = image_dist%i%row_decimation
      ncol_images = image_dist%i%col_decimation
      row_mult = image_dist%i%row_multiplicity
      col_mult = image_dist%i%col_multiplicity
      nvprows = nprows*nrow_images
      nvpcols = npcols*ncol_images
      !
      IF (PRESENT(myprow)) THEN
         my_prow = myprow
      ELSE
         my_prow = mp%mp%myprow
      END IF
      IF (PRESENT(mypcol)) THEN
         my_pcol = mypcol
      ELSE
         my_pcol = mp%mp%mypcol
      END IF
      !
      IF (.NOT. PRESENT(myvprow)) THEN
         vrow = my_prow*nrow_images + myrowi - 1
      ELSE
         vrow = myvprow
      END IF
      IF (.NOT. PRESENT(myvpcol)) THEN
         vcol = my_pcol*ncol_images + mycoli - 1
      ELSE
         vcol = myvpcol
      END IF
      !
      IF (PRESENT(vprow_shift)) vrow = vrow + vprow_shift
      IF (PRESENT(vpcol_shift)) vcol = vcol + vpcol_shift
      IF (PRESENT(shifting)) THEN
         SELECT CASE (shifting)
         CASE ('R')
            vrow = vrow + my_pcol*row_mult
         CASE ('L')
            vcol = vcol + my_prow*col_mult
         CASE ('r')
            vrow = vrow - my_pcol*row_mult
         CASE ('l')
            vcol = vcol - my_prow*col_mult
         END SELECT
      END IF
      vrow = MODULO(vrow, nvprows)
      vcol = MODULO(vcol, nvpcols)
      IF (PRESENT(prow)) prow = vrow/nrow_images
      IF (PRESENT(rowi)) rowi = MODULO(vrow, nrow_images) + 1
      IF (PRESENT(pcol)) pcol = vcol/ncol_images
      IF (PRESENT(coli)) coli = MODULO(vcol, ncol_images) + 1
      IF (PRESENT(vprow)) vprow = vrow
      IF (PRESENT(vpcol)) vpcol = vcol
   END SUBROUTINE image_calculator