MODULE iscplhsb
  USE oce
  USE dom_oce
  USE domwri
  USE domngb
  USE phycst
  USE sbc_oce
  USE iscplini
  USE in_out_manager
  USE lib_mpp
  USE lib_fortran
  USE lbclnk
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: iscpl_div
  PUBLIC :: iscpl_cons
  CONTAINS
  SUBROUTINE iscpl_cons(ptmask_b, psmask_b, pe3t_b, pts_flx, pvol_flx, prdt_iscpl)
    REAL(KIND = wp), DIMENSION(:, :, :), INTENT(IN ) :: ptmask_b
    REAL(KIND = wp), DIMENSION(:, :, :), INTENT(IN ) :: pe3t_b
    REAL(KIND = wp), DIMENSION(:, :), INTENT(IN ) :: psmask_b
    REAL(KIND = wp), DIMENSION(:, :, :, :), INTENT(OUT) :: pts_flx
    REAL(KIND = wp), DIMENSION(:, :, :), INTENT(OUT) :: pvol_flx
    REAL(KIND = wp), INTENT(IN ) :: prdt_iscpl
    INTEGER :: ji, jj, jk
    INTEGER :: jip1, jim1, jjp1, jjm1
    REAL(KIND = wp) :: summsk, zsum, zsumn, zjip1_ratio, zjim1_ratio, zdtem, zde3t, z1_rdtiscpl
    REAL(KIND = wp) :: zarea, zsum1, zsumb, zjjp1_ratio, zjjm1_ratio, zdsal
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zdssh
    REAL(KIND = wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat
    REAL(KIND = wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal
    INTEGER, DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts
    INTEGER :: jpts, npts
    !$ACC KERNELS
    zde3t = 0._wp
    zdsal = 0._wp
    zdtem = 0._wp
    pvol_flx(:, :, :) = 0._wp
    pts_flx(:, :, :, :) = 0._wp
    z1_rdtiscpl = 1._wp / prdt_iscpl
    tsb(:, :, :, jp_tem) = tsb(:, :, :, jp_tem) * ptmask_b(:, :, :)
    tsn(:, :, :, jp_tem) = tsn(:, :, :, jp_tem) * tmask(:, :, :)
    tsb(:, :, :, jp_sal) = tsb(:, :, :, jp_sal) * ptmask_b(:, :, :)
    tsn(:, :, :, jp_sal) = tsn(:, :, :, jp_sal) * tmask(:, :, :)
    zdssh(:, :) = sshn(:, :) * ssmask(:, :) - sshb(:, :) * psmask_b(:, :)
    IF (.NOT. ln_linssh) zdssh = 0.0_wp
    !$ACC END KERNELS
    DO jk = 1, jpk - 1
      DO jj = 2, jpj - 1
        DO ji = 2, jpim1
          IF (tmask_h(ji, jj) == 1._wp) THEN
            zde3t = e3t_n(ji, jj, jk) * tmask(ji, jj, jk) - pe3t_b(ji, jj, jk) * ptmask_b(ji, jj, jk)
            zdtem = tsn(ji, jj, jk, jp_tem) * e3t_n(ji, jj, jk) * tmask(ji, jj, jk) - tsb(ji, jj, jk, jp_tem) * pe3t_b(ji, jj, jk) * ptmask_b(ji, jj, jk)
            zdsal = tsn(ji, jj, jk, jp_sal) * e3t_n(ji, jj, jk) * tmask(ji, jj, jk) - tsb(ji, jj, jk, jp_sal) * pe3t_b(ji, jj, jk) * ptmask_b(ji, jj, jk)
            IF (ptmask_b(ji, jj, jk) == 1._wp .OR. tmask(ji, jj, jk) == 1._wp) THEN
              zde3t = zde3t + zdssh(ji, jj)
              zdssh(ji, jj) = 0._wp
            END IF
            pvol_flx(ji, jj, jk) = pvol_flx(ji, jj, jk) + zde3t * z1_rdtiscpl
            pts_flx(ji, jj, jk, jp_sal) = pts_flx(ji, jj, jk, jp_sal) + zdsal * z1_rdtiscpl
            pts_flx(ji, jj, jk, jp_tem) = pts_flx(ji, jj, jk, jp_tem) + zdtem * z1_rdtiscpl
            IF (tmask(ji, jj, jk) == 0._wp .AND. ptmask_b(ji, jj, jk) == 1._wp) THEN
              jip1 = ji + 1
              jim1 = ji - 1
              jjp1 = jj + 1
              jjm1 = jj - 1
              zsum = e1e2t(ji, jjp1) * tmask(ji, jjp1, jk) + e1e2t(ji, jjm1) * tmask(ji, jjm1, jk) + e1e2t(jim1, jj) * tmask(jim1, jj, jk) + e1e2t(jip1, jj) * tmask(jip1, jj, jk)
              IF (zsum /= 0._wp) THEN
                zjip1_ratio = e1e2t(jip1, jj) * tmask(jip1, jj, jk) / zsum
                zjim1_ratio = e1e2t(jim1, jj) * tmask(jim1, jj, jk) / zsum
                zjjp1_ratio = e1e2t(ji, jjp1) * tmask(ji, jjp1, jk) / zsum
                zjjm1_ratio = e1e2t(ji, jjm1) * tmask(ji, jjm1, jk) / zsum
                pvol_flx(ji, jjp1, jk) = pvol_flx(ji, jjp1, jk) + pvol_flx(ji, jj, jk) * zjjp1_ratio
                pvol_flx(ji, jjm1, jk) = pvol_flx(ji, jjm1, jk) + pvol_flx(ji, jj, jk) * zjjm1_ratio
                pvol_flx(jip1, jj, jk) = pvol_flx(jip1, jj, jk) + pvol_flx(ji, jj, jk) * zjip1_ratio
                pvol_flx(jim1, jj, jk) = pvol_flx(jim1, jj, jk) + pvol_flx(ji, jj, jk) * zjim1_ratio
                pts_flx(ji, jjp1, jk, jp_sal) = pts_flx(ji, jjp1, jk, jp_sal) + pts_flx(ji, jj, jk, jp_sal) * zjjp1_ratio
                pts_flx(ji, jjm1, jk, jp_sal) = pts_flx(ji, jjm1, jk, jp_sal) + pts_flx(ji, jj, jk, jp_sal) * zjjm1_ratio
                pts_flx(jip1, jj, jk, jp_sal) = pts_flx(jip1, jj, jk, jp_sal) + pts_flx(ji, jj, jk, jp_sal) * zjip1_ratio
                pts_flx(jim1, jj, jk, jp_sal) = pts_flx(jim1, jj, jk, jp_sal) + pts_flx(ji, jj, jk, jp_sal) * zjim1_ratio
                pts_flx(ji, jjp1, jk, jp_tem) = pts_flx(ji, jjp1, jk, jp_tem) + pts_flx(ji, jj, jk, jp_tem) * zjjp1_ratio
                pts_flx(ji, jjm1, jk, jp_tem) = pts_flx(ji, jjm1, jk, jp_tem) + pts_flx(ji, jj, jk, jp_tem) * zjjm1_ratio
                pts_flx(jip1, jj, jk, jp_tem) = pts_flx(jip1, jj, jk, jp_tem) + pts_flx(ji, jj, jk, jp_tem) * zjip1_ratio
                pts_flx(jim1, jj, jk, jp_tem) = pts_flx(jim1, jj, jk, jp_tem) + pts_flx(ji, jj, jk, jp_tem) * zjim1_ratio
                pvol_flx(ji, jj, jk) = 0._wp
                pts_flx(ji, jj, jk, jp_sal) = 0._wp
                pts_flx(ji, jj, jk, jp_tem) = 0._wp
              ELSE IF (zsum == 0._wp) THEN
                IF (tmask(ji, jj, jk + 1) == 1._wp) THEN
                  pvol_flx(ji, jj, jk + 1) = pvol_flx(ji, jj, jk + 1) + pvol_flx(ji, jj, jk)
                  pts_flx(ji, jj, jk + 1, jp_sal) = pts_flx(ji, jj, jk + 1, jp_sal) + pts_flx(ji, jj, jk, jp_sal)
                  pts_flx(ji, jj, jk + 1, jp_tem) = pts_flx(ji, jj, jk + 1, jp_tem) + pts_flx(ji, jj, jk, jp_tem)
                  pvol_flx(ji, jj, jk) = 0._wp
                  pts_flx(ji, jj, jk, jp_sal) = 0._wp
                  pts_flx(ji, jj, jk, jp_tem) = 0._wp
                ELSE
                  IF (lwp) THEN
                    WRITE(numout, FMT = *) 'W A R N I N G iscpl: no adjacent cell on the vertical and horizontal'
                    WRITE(numout, FMT = *) '                     ', mig(ji), ' ', mjg(jj), ' ', jk
                    WRITE(numout, FMT = *) '                     ', ji, ' ', jj, ' ', jk, ' ', narea
                    WRITE(numout, FMT = *) ' we are now looking for the closest wet cell on the horizontal '
                  END IF
                END IF
              END IF
            END IF
          END IF
        END DO
      END DO
    END DO
    STOP ' iscpl_cons:   please modify this module !'
    ALLOCATE(inpts(jpnij))
    inpts(:) = 0
    DO jk = 1, jpk - 1
      DO jj = 2, jpj - 1
        DO ji = 2, jpim1
          IF (ptmask_b(ji, jj, jk) == 1._wp .AND. tmask(ji, jj, jk + 1) == 0._wp .AND. tmask_h(ji, jj) == 1._wp .AND. SUM(tmask(ji - 1 : ji + 1, jj, jk)) + SUM(tmask(ji, jj - 1 : jj + 1, jk)) == 0._wp) THEN
            inpts(narea) = inpts(narea) + 1
          END IF
        END DO
      END DO
    END DO
    CALL mpp_max(inpts, jpnij)
    npts = SUM(inpts)
    ALLOCATE(ixpts(npts), iypts(npts), izpts(npts), zcorr_vol(npts), zcorr_sal(npts), zcorr_tem(npts), zlon(npts), zlat(npts))
    ixpts(:) = - 9999
    iypts(:) = - 9999
    izpts(:) = - 9999
    zlon(:) = - 1.0E20_wp
    zlat(:) = - 1.0E20_wp
    zcorr_vol(:) = - 1.0E20_wp
    zcorr_sal(:) = - 1.0E20_wp
    zcorr_tem(:) = - 1.0E20_wp
    jpts = SUM(inpts(1 : narea - 1))
    DO jk = 1, jpk - 1
      DO jj = 2, jpj - 1
        DO ji = 2, jpim1
          IF (ptmask_b(ji, jj, jk) == 1._wp .AND. tmask(ji, jj, jk + 1) == 0._wp .AND. tmask_h(ji, jj) == 1._wp .AND. SUM(tmask(ji - 1 : ji + 1, jj, jk)) + SUM(tmask(ji, jj - 1 : jj + 1, jk)) == 0._wp) THEN
            jpts = jpts + 1
            ixpts(jpts) = ji
            iypts(jpts) = jj
            izpts(jpts) = jk
            zlon(jpts) = glamt(ji, jj)
            zlat(jpts) = gphit(ji, jj)
            zcorr_vol(jpts) = pvol_flx(ji, jj, jk)
            zcorr_sal(jpts) = pts_flx(ji, jj, jk, jp_sal)
            zcorr_tem(jpts) = pts_flx(ji, jj, jk, jp_tem)
            pvol_flx(ji, jj, jk) = 0.0_wp
            pts_flx(ji, jj, jk, jp_sal) = 0.0_wp
            pts_flx(ji, jj, jk, jp_tem) = 0.0_wp
          END IF
        END DO
      END DO
    END DO
    CALL mpp_max(zlat, npts)
    CALL mpp_max(zlon, npts)
    CALL mpp_max(izpts, npts)
    CALL mpp_max(zcorr_vol, npts)
    CALL mpp_max(zcorr_sal, npts)
    CALL mpp_max(zcorr_tem, npts)
    DO jpts = 1, npts
      CALL dom_ngb(zlon(jpts), zlat(jpts), ixpts(jpts), iypts(jpts), 'T', izpts(jpts))
      !$ACC KERNELS
      DO jj = mj0(iypts(jpts)), mj1(iypts(jpts))
        DO ji = mi0(ixpts(jpts)), mi1(ixpts(jpts))
          jk = izpts(jpts)
          IF (tmask_h(ji, jj) == 1._wp) THEN
            pvol_flx(ji, jj, jk) = pvol_flx(ji, jj, jk) + zcorr_vol(jpts)
            pts_flx(ji, jj, jk, jp_sal) = pts_flx(ji, jj, jk, jp_sal) + zcorr_sal(jpts)
            pts_flx(ji, jj, jk, jp_tem) = pts_flx(ji, jj, jk, jp_tem) + zcorr_tem(jpts)
            zcorr_vol(jpts) = 0.0_wp
            zcorr_sal(jpts) = 0.0_wp
            zcorr_tem(jpts) = 0.0_wp
          END IF
        END DO
      END DO
      !$ACC END KERNELS
    END DO
    DEALLOCATE(inpts)
    DEALLOCATE(ixpts, iypts, izpts, zcorr_vol, zcorr_sal, zcorr_tem, zlon, zlat)
    !$ACC KERNELS
    pvol_flx(:, :, :) = pvol_flx(:, :, :) * tmask(:, :, :)
    pts_flx(:, :, :, jp_sal) = pts_flx(:, :, :, jp_sal) * tmask(:, :, :)
    pts_flx(:, :, :, jp_tem) = pts_flx(:, :, :, jp_tem) * tmask(:, :, :)
    !$ACC END KERNELS
  END SUBROUTINE iscpl_cons
  SUBROUTINE iscpl_div(phdivn)
    REAL(KIND = wp), DIMENSION(:, :, :), INTENT(INOUT) :: phdivn
    INTEGER :: ji, jj, jk
    !$ACC KERNELS
    DO jk = 1, jpk
      DO jj = 1, jpj
        DO ji = 1, jpi
          phdivn(ji, jj, jk) = phdivn(ji, jj, jk) + hdiv_iscpl(ji, jj, jk) / e3t_n(ji, jj, jk)
        END DO
      END DO
    END DO
    !$ACC END KERNELS
  END SUBROUTINE iscpl_div
END MODULE iscplhsb


cc ------------ dpmjet3.4 - authors: S.Roesler, R.Engel, J.Ranft -------
cc -------- phojet1.12-40 - authors: S.Roesler, R.Engel, J.Ranft -------
cc                                                      - oct'13 -------
cc ----------- pythia-6.4 - authors: Torbjorn Sjostrand, Lund'10 -------
cc ---------------------------------------------------------------------
cc                                  converted for use with FLUKA -------
cc                                                      - oct'13 -------

C...PYBOOK
C...Books a histogram.

      SUBROUTINE PYBOOK(ID,TITLE,NX,XL,XU)

C...Double precision declaration.
      IMPLICIT DOUBLE PRECISION(A-H, O-Z)
      IMPLICIT INTEGER(I-N)
C...Commonblock.
      include 'inc/pybins'

C...Local character variables.
      CHARACTER TITLE*(*), TITFX*60

C...Check that input is sensible. Find initial address in memory.
      IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28,
     &'(PYBOOK:) not allowed histogram number')
      IF(NX.LE.0.OR.NX.GT.100) CALL PYERRM(28,
     &'(PYBOOK:) not allowed number of bins')
      IF(XL.GE.XU) CALL PYERRM(28,
     &'(PYBOOK:) x limits in wrong order')
      INDX(ID)=IHIST(4)
      IHIST(4)=IHIST(4)+28+NX
      IF(IHIST(4).GT.IHIST(2)) CALL PYERRM(28,
     &'(PYBOOK:) out of histogram space')
      IS=INDX(ID)

C...Store histogram size and reset contents.
      BIN(IS+1)=NX
      BIN(IS+2)=XL
      BIN(IS+3)=XU
      BIN(IS+4)=(XU-XL)/NX
      CALL PYNULL(ID)

C...Store title by conversion to integer to double precision.
      TITFX=TITLE//' '
      DO 100 IT=1,20
        BIN(IS+8+NX+IT)=256**2*ICHAR(TITFX(3*IT-2:3*IT-2))+
     &  256*ICHAR(TITFX(3*IT-1:3*IT-1))+ICHAR(TITFX(3*IT:3*IT))
  100 CONTINUE

      RETURN
      END


      PROGRAM QUIKVIS
      IMPLICIT REAL*8 (A-H,O-Z)
C
C THIS PROGRAM GIVES AVAILABILITY INFORMATION FOR FIXED OR MOVING
C CELESTIAL TARGETS(IE, STARS, PLANETS, SUN,....).
C
C THE PROGRAM'S CHARACTERISTICS ARE:
C
C    - ORBITS ARE ASSUMED CIRCULAR; NO DRAG OR HARMONICS
C
C    - ORBIT NIGHT CAN BE CONSIDERED
C    - EARTH LIMB AVOIDANCE ANGLE CAN BE SPECIFIED
C    - RAM VECTOR AVOIDANCE ANGLE CAN BE SPECIFIED
C    - MAX TARGET/ZENITH SEPARATION ANGLE CAN BE SPECIFIED
C
C***********************************************************************
C
C BY C PETRUZZO/GFSC/742.   2/86.
C       MODIFIED....
C
C***********************************************************************
C
C
      INCLUDE 'QUIKVIS.INC'
C
      CHARACTER*50 ENDTEXT
      LOGICAL DIDACASE/.FALSE./
C
C
      INTEGER*4 IDTARG(MAXTARGS)
C       IDTARG(I) = ID OF I'TH TARGET.  ZERO OR NEGATIVE ID'S ARE
C       IGNORED. NO RESERVED VALUES(IE, ANY ID MAY BE USED).  LOADED
C       BY QUIKVIS0A.
C
      CHARACTER*16 TARGNAMES(MAXTARGS)
C       TARGNAMES(I) = NAME OF I'TH TARGET.  MOVING CELESTIAL TARGS HAVE
C       RESERVED NAMES(SEE THE QUIKVIS USER GUIDE).  THE RESERVED NAMES
C       ARE USED BY SUBROUTINE TGLOC01.  LOADED BY QUIKVIS1.
C
      REAL*8 TARGPARM(NPARMS,MAXTARGS)
C       PARAMETERS GIVING THE TARGET LOCATION.  IF I'TH TARGET IS FIXED,
C       THE FOLLOWING HOLDS.  OTHERWISE, =ZEROS.  LOADED BY QUIKVIS1.
C         TARGPARM(1,I) = RIGHT ASCENSION
C         TARGPARM(2,I) = DECLINATION
C         TARGPARM(3,I) = X-COMPONENT OF UNIT VECTOR
C         TARGPARM(4,I) = Y-COMPONENT OF UNIT VECTOR
C         TARGPARM(5,I) = Z-COMPONENT OF UNIT VECTOR
C
      INTEGER*4 KTARGTYP(MAXTARGS)
C       IDTARG(I) = TARGET TYPE FOR I'TH TARGET(VALID VALUES: 1,3)
C       LOADED BY QUIKVIS1.
C
C
      CHARACTER*18 DATETIME,BEGINTIME,ENDTIME
C
C CODING COMMENT:
C
C      A DESIGN FEATURE OF QUIKVIS IS THAT GLOBAL PARAMETERS(THOSE
C      USED BY MORE THAN ONE ROUTINE) MAY BE MODIFIED ONLY IN THE
C      INITIALIZATION AND USER INPUT ROUTINES.  A WAY WAS NEEDED TO
C      MAKE THE GLOBAL VARIABLES AVAILABLE TO THE PROGRAM'S
C      SUBROUTINES.  PASSING GLOBAL VARIABLES VIA THE ARGUMENT
C      LISTS TO EACH LOWER LEVEL ROUTINE WOULD HAVE LED TO LONG
C      LISTS AND TO TEDIOUS MODIFICATIONS WHEN NEW QUANTITIES WERE
C      ADDED, AND WOULD HAVE PERMITTED CHANGES TO THE VALUES OF
C      GLOBAL VARIABLES ANYWHERE IN THE CODE.  HENCE, THE ARGUMENT
C      LIST APPROACH WAS REJECTED, AS WAS USING A COMMON BLOCK FOR
C      SIMILAR REASONS.  THE SOLUTION WAS TO HAVE A SUBROUTINE
C      SERVE AS A STORAGE AREA FOR THE GLOBAL VARIABLE VALUES.  THE
C      INITIALIZATION AND USER INPUT ROUTINES PLACE GLOBAL VARIABLE
C      VALUES IN THE STORAGE ROUTINE.  ALL OTHER ROUTINES ARE
C      INITIALIZED BY QUIKVIS3 BEFORE PROCESSING THE CURRENT CASE.
C      QUIKVIS3 INITIALIZES THEM BY LOADING THE GLOBAL VARIABLE VALUES
C      INTO EACH ROUTINE'S LOCAL VARIABLES.  GLOBAL VARIABLES ARE NOT
C      ADDRESSED OTHERWISE.  THE ADVANTAGE IS THAT ONE CANNOT CHANGE A
C      GLOBAL VARIABLE VALUE EXCEPT IN A HIGHLY VISIBLE WAY(IE, BY
C      CALLING THE STORAGE ROUTINE).  FOR TARGET-RELATED ARRAYS
C      IDTARG, TARGPARM, TARGNAMES, AND KTARGTYP, THIS APPROACH WAS
C      NOT USED BECAUSE THE SIZE OF THESE ARRAYS WOULD HAVE LED TO
C      EXCESSIVE IMAGE SIZE IF THEY WERE TREATED AS LOCAL VARIABLES IN
C      EACH ROUTINE.
C
C      QUIKVIS999 IS THE GLOBAL VARIABLE STORAGE ROUTINE. ARRAYS
C      R8DATA, I4DATA, AND L4DATA ARE USED IN THE CALLING
C      QUIKVIS999 BECAUSE IT SIMPLIFIES THE CALL AND ALLOWS FOR
C      EXPANSION IN THE NUMBER OF GLOBAL VARIABLES WITHOUT MODIFYING
C      THE CALL STATEMENT.  THE INCLUDE FILE, QUIKVIS.INC, SETS UP
C      EQUIVALENCES BETWEEN THE ARRAY ELEMENTS AND LOCAL VARIABLES.
C      ANY CHANGE TO QUIKVIS.INC REQUIRES A RECOMPILATION OF ALL
C      ROUTINES BEGINNING WITH 'QUIKVIS'.
C
C
C ****************
C *  INITIALIZE  *
C ****************
C
C ***** SHOW THE DATE AND TIME THIS RUN BEGINS
C
      BEGINTIME = DATETIME(0)
      WRITE(LUPRINT,1020) BEGINTIME
C
C
C ***** INITIALIZE PROGRAM PARAMETERS AND CONTROLS.  SPECIFY TARGET ID'S
C       AND OBSERVATION REQUIREMENTS.
C
      CALL QUIKVIS0(IDTARG,IERR)
      IF(IERR.NE.0) GO TO 9999
C
C
C ***** LOAD DATA ARRAYS WITH TARGET INFO.  TARGET ID'S WERE SPECIFIED
C       DURING THE INITIALIZATION CALL TO QUIKVIS0.
C
      CALL QUIKVIS1(IDTARG,TARGNAMES,KTARGTYP,TARGPARM,IERR)
      IF(IERR.NE.0) GO TO 9999
C
C
C
C ***** SET MAIN'S INTERNAL VARIABLES THAT CORRESPOND TO THE PROGRAM'S
C       LOCAL VARIABLES.
C
      CALL QUIKVIS999(-1,R8DATA,I4DATA,L4DATA)
C
      NCASE = 0
 1000 CONTINUE
C
C ************************
C *  MAJOR PROGRAM LOOP  *
C ************************
C
      NCASE = NCASE + 1
      WRITE(LUPROMPT,100) NCASE
C
C    UPDATE THE NCASE GLOBAL VARIABLE FOR RETRIEVAL BY OTHER ROUTINES
      CALL QUIKVIS999(1,R8DATA,I4DATA,L4DATA)
C
C
C ***** GET USER INPUT.
C
      CALL QUIKVIS2(IERR,IEND)
      CALL QUIKVIS999(-1,R8DATA,I4DATA,L4DATA) ! UPDATE MAIN'S VARIABLES
      IF(IEND.NE.0) GO TO 9999
      IF(IERR.NE.0) THEN
        IF(INTERACTIVE) THEN
          WRITE(LUPROMPT,4302) NCASE
          GO TO 1000
        ELSE
          GO TO 9999
          END IF
        END IF
C
C
C ***** INITIALIZE THE REMAINING ROUTINES BEFORE CALLING THEM VIA
C       QUIKVIS4, QUIKVIS5, AND THEIR LOWER LEVEL ROUTINES
C
      CALL QUIKVIS3
C
C
C ***** OUTPUT THE CURRENT PROGRAM CONTROL VALUES
C
      CALL QUIKVIS4(IDTARG,TARGNAMES,KTARGTYP,TARGPARM)
C
C
C ***** EXECUTE THIS CASE AND OUTPUT RESULTS TO THE APPROPRIATE UNITS.
C
      CALL QUIKVIS5(IDTARG,TARGNAMES,KTARGTYP,TARGPARM,IERR)
C
      WRITE(LUPROMPT,4301) NCASE,DATETIME(0)
      IF(IERR.NE.0) GO TO 9999
C
      DIDACASE = .TRUE.
      GO TO 1000    ! LOOP FOR ANOTHER CASE
C
C
C *****************
C *  END THE RUN  *
C *****************
C
 9999 CONTINUE
C
      ENDTIME=DATETIME(0)
C
      ENDTEXT = ' QUIKVIS. NORMAL END.'
      IF(IEND.NE.0 .AND. .NOT.DIDACASE) ENDTEXT =
     *   ' QUIKVIS. NORMAL END, BUT NO CASES WERE EXECUTED.'
      IF(IERR.NE.0) ENDTEXT = 'QUIKVIS. ERROR END.'
C
      WRITE(LUPRINT,1040) BEGINTIME,ENDTIME,ENDTEXT
C
      CALL CHBLANK(ENDTEXT,K1,K2)
      TYPE *, ENDTEXT(1:K2) // '   ' // ENDTIME
      STOP ' '
C
  100 FORMAT(////,' ********** START CASE',I3,' **********'////)
 1020 FORMAT(' START QUIKVIS PROGRAM     ',A)
 4301 FORMAT(/,' END PROCESSING CASE ',I2,5X,A/)
 4302 FORMAT(/,' CASE ',I2,' BYPASSED BECAUSE OF ERRORS.'/)
 1040 FORMAT(///,'1'/,
     *  ' END QUIKVIS PROGRAM.'//,
     *  '    START TIME WAS ',A/,
     *  '      END TIME WAS ',A//,
     *  A)
      END


!> Various definitions and tools for running an NGA2 simulation
module simulation
   use string,            only: str_medium
   use precision,         only: WP
   use geometry,          only: cfg1,cfg2,cfg3
   use geometry,          only: xinj_dist,inj_norm_diam,rli0,rlo0,rgi0,rlo0_spray,rgi0_spray
   use incomp_class,      only: incomp
   use tpns_class,        only: tpns
   use vfs_class,         only: vfs
   use ccl_class,         only: ccl
   use lpt_class,         only: lpt
   use coupler_class,     only: coupler
   use sgsmodel_class,    only: sgsmodel
   use timetracker_class, only: timetracker
   use ensight_class,     only: ensight
   use event_class,       only: event
   use datafile_class,    only: datafile
   use monitor_class,     only: monitor
   implicit none
   private

   !> Single-phase incompressible flow solver, and corresponding time tracker and sgs model
   type(incomp),      public :: fs1
   type(timetracker), public :: time1
   type(sgsmodel),    public :: sgs1

   ! Couplers between 1 and 2
   type(coupler),     public :: cpl12x,cpl12y,cpl12z

   !> Two-phase incompressible flow solver, VF solver with CCL, and corresponding time tracker and sgs model
   type(tpns),        public :: fs2
   type(vfs),         public :: vf2
   type(timetracker), public :: time2
   type(sgsmodel),    public :: sgs2
   type(ccl),         public :: cc2

   ! Couplers between 2 and 3
   type(coupler),     public :: cpl23x,cpl23y,cpl23z

   !> Single-phase incompressible flow solver with lpt, and corresponding time tracker and sgs model
   type(incomp),      public :: fs3
   type(lpt),         public :: lp3
   type(timetracker), public :: time3
   type(sgsmodel),    public :: sgs3

   !> Provide three datafiles and an event tracker for saving restarts
   type(event)    :: save_evt
   type(datafile) :: df1,df2,df3
   character(len=str_medium) :: irl_file
   character(len=str_medium) :: lpt_file
   logical :: restarted

   !> Ensight postprocessing
   type(ensight) :: ens_out1
   type(ensight) :: ens_out2
   type(ensight) :: ens_out3
   type(event)   :: ens_evt1
   type(event)   :: ens_evt2
   type(event)   :: ens_evt3

   !> Simulation monitor file
   type(monitor) :: mfile1,cflfile1
   type(monitor) :: mfile2,cflfile2
   type(monitor) :: mfile3,cflfile3,sprayfile

   public :: simulation_init,simulation_run,simulation_final

   !> Private work arrays
   real(WP), dimension(:,:,:), allocatable :: resU1,resV1,resW1
   real(WP), dimension(:,:,:), allocatable :: Ui1,Vi1,Wi1
   real(WP), dimension(:,:,:,:), allocatable :: SR1
   real(WP), dimension(:,:,:), allocatable :: resU2,resV2,resW2
   real(WP), dimension(:,:,:), allocatable :: Ui2,Vi2,Wi2
   real(WP), dimension(:,:,:,:), allocatable :: SR2
   real(WP), dimension(:,:,:), allocatable :: resU3,resV3,resW3
   real(WP), dimension(:,:,:), allocatable :: Ui3,Vi3,Wi3
   real(WP), dimension(:,:,:,:), allocatable :: SR3
   real(WP), dimension(:,:,:), allocatable :: U2on3,V2on3,W2on3

   !> Transfer model parameters
   real(WP) :: filmthickness_over_dx  =5.0e-1_WP
   real(WP) :: min_filmthickness      =1.0e-6_WP
   real(WP) :: diam_over_filmthickness=1.0e+1_WP
   real(WP) :: max_eccentricity       =5.0e-1_WP
   real(WP) :: d_threshold            =1.0e-3_WP

contains

   !> Function that localizes the right domain boundary
   function right_boundary(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      logical :: isIn
      isIn=.false.
      if (i.eq.pg%imax+1) isIn=.true.
   end function right_boundary

   !> Function that localizes injector at -y
   function inj1(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      real(WP) ::hyp,rise,run
      logical :: isIn
      isIn=.false.
      ! Check injector x-z plane
      hyp =norm2([pg%xm(i),pg%ym(j),pg%zm(k)]-[xinj_dist,0.0_WP,0.0_WP])
      rise=abs(pg%ym(j))
      run =sqrt(hyp**2-rise**2)
      if (run.le.inj_norm_diam/2.0_WP.and.j.eq.pg%jmin) isIn=.true.
   end function inj1

   !> Function that localizes injector at +y
   function inj2(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      real(WP) ::hyp,rise,run
      logical :: isIn
      isIn=.false.
      ! Check injector x-z plane
      hyp =norm2([pg%xm(i),pg%ym(j),pg%zm(k)]-[xinj_dist,0.0_WP,0.0_WP])
      rise=abs(pg%ym(j))
      run =sqrt(hyp**2-rise**2)
      if (run.le.inj_norm_diam/2.0_WP.and.j.eq.pg%jmax+1) isIn=.true.
   end function inj2

   !> Function that localizes injector at -z
   function inj3(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      real(WP) ::hyp,rise,run
      logical :: isIn
      isIn=.false.
      ! Check injector x-y plane
      hyp =norm2([pg%xm(i),pg%ym(j),pg%zm(k)]-[xinj_dist,0.0_WP,0.0_WP])
      rise=abs(pg%zm(k))
      run =sqrt(hyp**2-rise**2)
      if (run.le.inj_norm_diam/2.0_WP.and.k.eq.pg%kmin) isIn=.true.
   end function inj3

   !> Function that localizes injector at +z
   function inj4(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      real(WP) ::hyp,rise,run
      logical :: isIn
      isIn=.false.
      ! Check injector x-y plane
      hyp =norm2([pg%xm(i),pg%ym(j),pg%zm(k)]-[xinj_dist,0.0_WP,0.0_WP] )
      rise=abs(pg%zm(k))
      run =sqrt(hyp**2-rise**2)
      if (run.le.inj_norm_diam/2.0_WP.and.k.eq.pg%kmax+1) isIn=.true.
   end function inj4

   !> Function that localizes liquid stream at -x
   function liq_inj(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      logical :: isIn
      real(WP) :: rad
      isIn=.false.
      rad=sqrt(pg%ym(j)**2+pg%zm(k)**2)
      if (rad.lt.rli0.and.i.eq.pg%imin) isIn=.true.
   end function liq_inj

   !> Function that localizes gas stream at -x
   function gas_inj(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      logical :: isIn
      real(WP) :: rad
      isIn=.false.
      rad=sqrt(pg%ym(j)**2+pg%zm(k)**2)
      if (rad.ge.rlo0.and.rad.lt.rgi0.and.i.eq.pg%imin) isIn=.true.
   end function gas_inj

   !> Function that localizes gas stream at -x
   function gas_inj_spray(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      logical :: isIn
      real(WP) :: rad
      isIn=.false.
      rad=sqrt(pg%ym(j)**2+pg%zm(k)**2)
      if (rad.ge.rlo0_spray.and.rad.lt.rgi0_spray.and.i.eq.pg%imin) isIn=.true.
   end function gas_inj_spray

   !> Function that localizes the top (y+) of the domain
   function yp_locator(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      implicit none
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      logical :: isIn
      isIn=.false.
      if (j.eq.pg%jmax+1) isIn=.true.
   end function yp_locator

   !> Function that localizes the bottom (y-) of the domain
   function ym_locator(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      implicit none
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      logical :: isIn
      isIn=.false.
      if (j.eq.pg%jmin) isIn=.true.
   end function ym_locator

   !> Function that localizes the top (z+) of the domain
   function zp_locator(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      implicit none
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      logical :: isIn
      isIn=.false.
      if (k.eq.pg%kmax+1) isIn=.true.
   end function zp_locator

   !> Function that localizes the bottom (z-) of the domain
   function zm_locator(pg,i,j,k) result(isIn)
      use pgrid_class, only: pgrid
      implicit none
      class(pgrid), intent(in) :: pg
      integer, intent(in) :: i,j,k
      logical :: isIn
      isIn=.false.
      if (k.eq.pg%kmin) isIn=.true.
   end function zm_locator

   !> Initialization of problem solver
   subroutine simulation_init
      use param, only: param_read
      implicit none

      ! Handle restart/saves here
      restart_and_save: block
         character(len=str_medium) :: dir_restart
         ! CAREFUL - WE NEED TO CREATE THE TIMETRACKER BEFORE THE EVENT !
         time2=timetracker(cfg2%amRoot,name='nozzle_exterior')
         ! Create event for saving restart files
         save_evt=event(time2,'Restart output')
         call param_read('Restart output period',save_evt%tper)
         ! Check if we are restarting
         call param_read(tag='Restart from',val=dir_restart,short='r',default='')
         restarted=.false.; if (len_trim(dir_restart).gt.0) restarted=.true.
         if (restarted) then
            ! If we are, read the name of the directory
            call param_read('Restart from',dir_restart,'r')
            ! Read the two datafiles and the name of the IRL file to read later
            df1=datafile(pg=cfg1,fdata=trim(adjustl(dir_restart))//'/'//'data.1')
            df2=datafile(pg=cfg2,fdata=trim(adjustl(dir_restart))//'/'//'data.2')
            df3=datafile(pg=cfg3,fdata=trim(adjustl(dir_restart))//'/'//'data.3')
            irl_file=trim(adjustl(dir_restart))//'/'//'data.irl'
            lpt_file=trim(adjustl(dir_restart))//'/'//'data.lpt'
         else
            ! If we are not restarting, we will still need datafiles for saving restart files
            df1=datafile(pg=cfg1,filename=trim(cfg1%name),nval=2,nvar=9)
            df1%valname(1)='t'
            df1%valname(2)='dt'
            df1%varname(1)='U'
            df1%varname(2)='V'
            df1%varname(3)='W'
            df1%varname(4)='P'
            df1%varname(5)='Uold'
            df1%varname(6)='Vold'
            df1%varname(7)='Wold'
            df1%varname(8)='LM'
            df1%varname(9)='MM'
            df2=datafile(pg=cfg2,filename=trim(cfg2%name),nval=2,nvar=10)
            df2%valname(1)='t'
            df2%valname(2)='dt'
            df2%varname(1)='U'
            df2%varname(2)='V'
            df2%varname(3)='W'
            df2%varname(4)='P'
            df2%varname(5)='Pjx'
            df2%varname(6)='Pjy'
            df2%varname(7)='Pjz'
            df2%varname(8)='LM'
            df2%varname(9)='MM'
            df2%varname(10)='VF'
            df3=datafile(pg=cfg3,filename=trim(cfg3%name),nval=2,nvar=6)
            df3%valname(1)='t'
            df3%valname(2)='dt'
            df3%varname(1)='U'
            df3%varname(2)='V'
            df3%varname(3)='W'
            df3%varname(4)='P'
            df3%varname(5)='LM'
            df3%varname(6)='MM'
         end if
      end block restart_and_save

      ! ###############################################
      ! ######## PREPARE SOLVER COUPLING HERE #########
      ! ###############################################
      coupler_prep: block
         use parallel, only: group
         ! Create nozzle-to-atomization couplers
         cpl12x=coupler(src_grp=group,dst_grp=group,name='nozzle_to_atom_x'); call cpl12x%set_src(cfg1,'x'); call cpl12x%set_dst(cfg2,'x'); call cpl12x%initialize()
         cpl12y=coupler(src_grp=group,dst_grp=group,name='nozzle_to_atom_y'); call cpl12y%set_src(cfg1,'y'); call cpl12y%set_dst(cfg2,'y'); call cpl12y%initialize()
         cpl12z=coupler(src_grp=group,dst_grp=group,name='nozzle_to_atom_z'); call cpl12z%set_src(cfg1,'z'); call cpl12z%set_dst(cfg2,'z'); call cpl12z%initialize()
         ! Create atomization-to-spray couplers
         cpl23x=coupler(src_grp=group,dst_grp=group,name='atom_to_spray__x'); call cpl23x%set_src(cfg2,'x'); call cpl23x%set_dst(cfg3,'x'); call cpl23x%initialize()
         cpl23y=coupler(src_grp=group,dst_grp=group,name='atom_to_spray__y'); call cpl23y%set_src(cfg2,'y'); call cpl23y%set_dst(cfg3,'y'); call cpl23y%initialize()
         cpl23z=coupler(src_grp=group,dst_grp=group,name='atom_to_spray__z'); call cpl23z%set_src(cfg2,'z'); call cpl23z%set_dst(cfg3,'z'); call cpl23z%initialize()
      end block coupler_prep

      ! *****************************************************************************
      ! **************************** INITIALIZE SOLVER 2 ****************************
      ! *****************************************************************************

      ! Allocate work arrays for cfg2
      allocate_work_arrays2: block
         allocate(resU2(cfg2%imino_:cfg2%imaxo_,cfg2%jmino_:cfg2%jmaxo_,cfg2%kmino_:cfg2%kmaxo_))
         allocate(resV2(cfg2%imino_:cfg2%imaxo_,cfg2%jmino_:cfg2%jmaxo_,cfg2%kmino_:cfg2%kmaxo_))
         allocate(resW2(cfg2%imino_:cfg2%imaxo_,cfg2%jmino_:cfg2%jmaxo_,cfg2%kmino_:cfg2%kmaxo_))
         allocate(Ui2  (cfg2%imino_:cfg2%imaxo_,cfg2%jmino_:cfg2%jmaxo_,cfg2%kmino_:cfg2%kmaxo_))
         allocate(Vi2  (cfg2%imino_:cfg2%imaxo_,cfg2%jmino_:cfg2%jmaxo_,cfg2%kmino_:cfg2%kmaxo_))
         allocate(Wi2  (cfg2%imino_:cfg2%imaxo_,cfg2%jmino_:cfg2%jmaxo_,cfg2%kmino_:cfg2%kmaxo_))
         allocate(SR2(6,cfg2%imino_:cfg2%imaxo_,cfg2%jmino_:cfg2%jmaxo_,cfg2%kmino_:cfg2%kmaxo_))
      end block allocate_work_arrays2

      ! Initialize time tracker
      initialize_timetracker2: block
         !time2=timetracker(cfg2%amRoot,name='nozzle_exterior')   !< This is moved up for restarts!
         call param_read('2 Max timestep size',time2%dtmax)
         call param_read('2 Max cfl number',time2%cflmax)
         time2%dt=time2%dtmax
         time2%itmax=2
         ! Handle restart
         if (restarted) then
            call df2%pullval(name='t' ,val=time2%t )
            call df2%pullval(name='dt',val=time2%dt)
            time2%told=time2%t-time2%dt
         end if
      end block initialize_timetracker2

      ! Initialize our VOF solver and field
      create_and_initialize_vof2: block
         use vfs_class, only: lvira,r2p
         integer :: i,j,k
         real(WP) :: xloc,rad
         ! Create a VOF solver with LVIRA
         !vf2=vfs(cfg=cfg2,reconstruction_method=lvira,name='VOF')
         ! Create a VOF solver with R2P
         vf2=vfs(cfg=cfg2,reconstruction_method=r2p,name='VOF')
         !vf2%VFflot =1.0e-4_WP !< Enables flotsam removal
         !vf2%VFsheet=1.0e-2_WP !< Enables sheet removal
         ! Initialize to flat interface in liquid needle
         xloc=-0.001_WP !< Interface initially just inside the nozzle
         do k=vf2%cfg%kmino_,vf2%cfg%kmaxo_
            do j=vf2%cfg%jmino_,vf2%cfg%jmaxo_
               do i=vf2%cfg%imino_,vf2%cfg%imaxo_
                  rad=sqrt(vf2%cfg%ym(j)**2+vf2%cfg%zm(k)**2)
                  if (vf2%cfg%xm(i).lt.xloc.and.rad.le.rli0) then
                     vf2%VF(i,j,k)=1.0_WP
                  else
                     vf2%VF(i,j,k)=0.0_WP
                  end if
                  vf2%Lbary(:,i,j,k)=[vf2%cfg%xm(i),vf2%cfg%ym(j),vf2%cfg%zm(k)]
                  vf2%Gbary(:,i,j,k)=[vf2%cfg%xm(i),vf2%cfg%ym(j),vf2%cfg%zm(k)]
               end do
            end do
         end do
         ! Handle restart - using IRL data - tested but not working
         !if (restarted) then
         !   ! Get the IRL interface
         !   call vf2%read_interface(filename=trim(irl_file))
         !   ! Reset moments to guarantee compatibility with interface reconstruction
         !   call vf2%reset_volume_moments()
         !end if
         ! Handle restart - using VF data
         if (restarted) call df2%pullvar(name='VF',var=vf2%VF)
         ! Update the band
         call vf2%update_band()
         ! Perform interface reconstruction from VOF field
         call vf2%build_interface()
         ! Set interface planes at the boundaries
         call vf2%set_full_bcond()
         ! Create discontinuous polygon mesh from IRL interface
         call vf2%polygonalize_interface()
         ! Calculate distance from polygons
         call vf2%distance_from_polygon()
         ! Calculate subcell phasic volumes
         call vf2%subcell_vol()
         ! Calculate curvature
         call vf2%get_curvature()
         ! Reset moments to guarantee compatibility with interface reconstruction
         call vf2%reset_volume_moments()
      end block create_and_initialize_vof2

      ! Create a two-phase flow solver with bconds
      create_solver2: block
         use tpns_class, only: dirichlet,clipped_neumann,neumann
         use ils_class,  only: pcg_amg,gmres,gmres_amg
         use mathtools,  only: Pi
         ! Instanciate the solver
         fs2=tpns(cfg=cfg2,name='Two-phase NS')
         ! Assign constant viscosity to each phase
         call param_read('Liquid dynamic viscosity',fs2%visc_l)
         call param_read('Gas dynamic viscosity'   ,fs2%visc_g)
         ! Assign constant density to each phase
         call param_read('Liquid density',fs2%rho_l)
         call param_read('Gas density'   ,fs2%rho_g)
         ! Read in surface tension coefficient
         call param_read('Surface tension coefficient',fs2%sigma)
         call param_read('Static contact angle',fs2%contact_angle)
         fs2%contact_angle=fs2%contact_angle*Pi/180.0_WP
         ! Define direction gas/liquid stream boundary conditions
         call fs2%add_bcond(name='gas_inj',type=dirichlet      ,face='x',dir=-1,canCorrect=.false.,locator=gas_inj)
         call fs2%add_bcond(name='liq_inj',type=dirichlet      ,face='x',dir=-1,canCorrect=.false.,locator=liq_inj)
         ! Neumann on the side
         call fs2%add_bcond(name='bc_yp'  ,type=clipped_neumann,face='y',dir=+1,canCorrect=.true. ,locator=yp_locator)
         call fs2%add_bcond(name='bc_ym'  ,type=clipped_neumann,face='y',dir=-1,canCorrect=.true. ,locator=ym_locator)
         call fs2%add_bcond(name='bc_zp'  ,type=clipped_neumann,face='z',dir=+1,canCorrect=.true. ,locator=zp_locator)
         call fs2%add_bcond(name='bc_zm'  ,type=clipped_neumann,face='z',dir=-1,canCorrect=.true. ,locator=zm_locator)
         ! Outflow on the right
         call fs2%add_bcond(name='outflow',type=clipped_neumann,face='x',dir=+1,canCorrect=.true. ,locator=right_boundary)
         ! Configure pressure solver
         call param_read('Pressure iteration',fs2%psolv%maxit)
         call param_read('Pressure tolerance',fs2%psolv%rcvg)
         ! Configure implicit velocity solver
         call param_read('Implicit iteration',fs2%implicit%maxit)
         call param_read('Implicit tolerance',fs2%implicit%rcvg)
         ! Setup the solver
         call fs2%setup(pressure_ils=gmres_amg,implicit_ils=gmres_amg)
      end block create_solver2

      ! Initialize our velocity field
      initialize_velocity2: block
         use mathtools,  only: pi
         use tpns_class, only: bcond
         type(bcond), pointer :: mybc
         integer  :: n,i,j,k
         real(WP) :: rad,Uports
         real(WP) :: Q_SLPM,Q_SI,Aport
         real(WP), parameter :: SLPM2SI=1.66667E-5_WP
         ! Zero initial field
         fs2%U=0.0_WP; fs2%V=0.0_WP; fs2%W=0.0_WP
         ! Handle restart
         if (restarted) then
            call df2%pullvar(name='U'  ,var=fs2%U  )
            call df2%pullvar(name='V'  ,var=fs2%V  )
            call df2%pullvar(name='W'  ,var=fs2%W  )
            call df2%pullvar(name='P'  ,var=fs2%P  )
            call df2%pullvar(name='Pjx',var=fs2%Pjx)
            call df2%pullvar(name='Pjy',var=fs2%Pjy)
            call df2%pullvar(name='Pjz',var=fs2%Pjz)
         end if
         ! Apply Dirichlet at liquid injector port
         call param_read('Liquid flow rate (SLPM)',Q_SLPM)
         Q_SI=Q_SLPM*SLPM2SI
         Aport=pi*rli0**2
         Uports=Q_SI/Aport
         call fs2%get_bcond('liq_inj',mybc)
         do n=1,mybc%itr%no_
            i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n)
            fs2%U(i,j,k)=Uports
         end do
         ! Apply all other boundary conditions
         call fs2%apply_bcond(time2%t,time2%dt)
         ! Compute MFR through all boundary conditions
         call fs2%get_mfr()
         ! Adjust MFR for global mass balance
         call fs2%correct_mfr()
         ! Compute cell-centered velocity
         call fs2%interp_vel(Ui2,Vi2,Wi2)
         ! Compute divergence
         call fs2%get_div()
      end block initialize_velocity2

      ! Create a connected-component labeling object
      create_and_initialize_ccl2: block
         use vfs_class, only: VFlo
         ! Create the CCL object
         cc2=ccl(cfg=cfg2,name='CCL')
         cc2%max_interface_planes=2
         cc2%VFlo=VFlo
         cc2%dot_threshold=-0.5_WP
         cc2%thickness_cutoff=filmthickness_over_dx
         ! Perform CCL step
         call cc2%build_lists(VF=vf2%VF,poly=vf2%interface_polygon,U=fs2%U,V=fs2%V,W=fs2%W)
         call cc2%film_classify(Lbary=vf2%Lbary,Gbary=vf2%Gbary)
         call cc2%deallocate_lists()
      end block create_and_initialize_ccl2

      ! Create an LES model
      create_sgs2: block
         sgs2=sgsmodel(cfg=fs2%cfg,umask=fs2%umask,vmask=fs2%vmask,wmask=fs2%wmask)
         ! Handle restart
         if (restarted) then
            call df2%pullvar(name='LM',var=sgs2%LM)
            call df2%pullvar(name='MM',var=sgs2%MM)
         end if
      end block create_sgs2

      ! Add Ensight output
      create_ensight2: block
         ! Create Ensight output from cfg2
         ens_out2=ensight(cfg2,'atom')
         ! Create event for Ensight output
         ens_evt2=event(time2,'Ensight output')
         call param_read('2 Ensight output period',ens_evt2%tper)
         ! Add variables to output
         call ens_out2%add_vector('velocity',Ui2,Vi2,Wi2)
         call ens_out2%add_scalar('VOF',vf2%VF)
         call ens_out2%add_scalar('curvature',vf2%curv)
         call ens_out2%add_scalar('visc_t',sgs2%visc)
         call ens_out2%add_scalar('filmID',cc2%film_id)
         call ens_out2%add_scalar('filmThickness',cc2%film_thickness)
         call ens_out2%add_surface('vofplic',vf2%surfgrid)
         ! Output to ensight
         if (ens_evt2%occurs()) call ens_out2%write_data(time2%t)
      end block create_ensight2

      ! Create a monitor file
      create_monitor2: block
         ! Prepare some info about fields
         call fs2%get_cfl(time2%dt,time2%cfl)
         call fs2%get_max()
         call vf2%get_max()
         ! Create simulation monitor
         mfile2=monitor(fs2%cfg%amRoot,'simulation2')
         call mfile2%add_column(time2%n,'Timestep number')
         call mfile2%add_column(time2%t,'Time')
         call mfile2%add_column(time2%dt,'Timestep size')
         call mfile2%add_column(time2%cfl,'Maximum CFL')
         call mfile2%add_column(fs2%Umax,'Umax')
         call mfile2%add_column(fs2%Vmax,'Vmax')
         call mfile2%add_column(fs2%Wmax,'Wmax')
         call mfile2%add_column(fs2%Pmax,'Pmax')
         call mfile2%add_column(vf2%VFmax,'VOF maximum')
         call mfile2%add_column(vf2%VFmin,'VOF minimum')
         call mfile2%add_column(vf2%VFint,'VOF integral')
         call mfile2%add_column(fs2%divmax,'Maximum divergence')
         call mfile2%add_column(fs2%psolv%it,'Pressure iteration')
         call mfile2%add_column(fs2%psolv%rerr,'Pressure error')
         call mfile2%write()
         ! Create CFL monitor
         cflfile2=monitor(fs2%cfg%amRoot,'cfl2')
         call cflfile2%add_column(time2%n,'Timestep number')
         call cflfile2%add_column(time2%t,'Time')
         call cflfile2%add_column(fs2%CFLc_x,'Convective xCFL')
         call cflfile2%add_column(fs2%CFLc_y,'Convective yCFL')
         call cflfile2%add_column(fs2%CFLc_z,'Convective zCFL')
         call cflfile2%add_column(fs2%CFLv_x,'Viscous xCFL')
         call cflfile2%add_column(fs2%CFLv_y,'Viscous yCFL')
         call cflfile2%add_column(fs2%CFLv_z,'Viscous zCFL')
         call cflfile2%write()
      end block create_monitor2

      ! *****************************************************************************
      ! **************************** INITIALIZE SOLVER 1 ****************************
      ! *****************************************************************************

      ! Allocate work arrays for cfg1 solver
      allocate_work_arrays1: block
         allocate(resU1(cfg1%imino_:cfg1%imaxo_,cfg1%jmino_:cfg1%jmaxo_,cfg1%kmino_:cfg1%kmaxo_))
         allocate(resV1(cfg1%imino_:cfg1%imaxo_,cfg1%jmino_:cfg1%jmaxo_,cfg1%kmino_:cfg1%kmaxo_))
         allocate(resW1(cfg1%imino_:cfg1%imaxo_,cfg1%jmino_:cfg1%jmaxo_,cfg1%kmino_:cfg1%kmaxo_))
         allocate(Ui1  (cfg1%imino_:cfg1%imaxo_,cfg1%jmino_:cfg1%jmaxo_,cfg1%kmino_:cfg1%kmaxo_))
         allocate(Vi1  (cfg1%imino_:cfg1%imaxo_,cfg1%jmino_:cfg1%jmaxo_,cfg1%kmino_:cfg1%kmaxo_))
         allocate(Wi1  (cfg1%imino_:cfg1%imaxo_,cfg1%jmino_:cfg1%jmaxo_,cfg1%kmino_:cfg1%kmaxo_))
         allocate(SR1(6,cfg1%imino_:cfg1%imaxo_,cfg1%jmino_:cfg1%jmaxo_,cfg1%kmino_:cfg1%kmaxo_))
      end block allocate_work_arrays1

      ! Initialize time tracker
      initialize_timetracker1: block
         time1=timetracker(cfg1%amRoot,name='nozzle_interior')
         call param_read('1 Max timestep size',time1%dtmax)
         call param_read('1 Max cfl number',time1%cflmax)
         time1%dt=time1%dtmax
         time1%itmax=2
         ! Handle restart
         if (restarted) then
            call df1%pullval(name='t' ,val=time1%t )
            call df1%pullval(name='dt',val=time1%dt)
            time1%told=time1%t-time1%dt
         end if
      end block initialize_timetracker1

      ! Create an incompressible flow solver with bconds
      create_solver1: block
         use incomp_class, only: dirichlet,clipped_neumann
         use ils_class,    only: pcg_amg,gmres
         ! Create flow solver
         fs1=incomp(cfg=cfg1,name='Incompressible NS')
         ! Set the flow properties
         fs1%rho=fs2%rho_g
         fs1%visc=fs2%visc_g
         ! Define gas port boundary conditions
         call fs1%add_bcond(name='inj1',type=dirichlet,face='y',dir=-1,canCorrect=.false.,locator=inj1)
         call fs1%add_bcond(name='inj2',type=dirichlet,face='y',dir=+1,canCorrect=.false.,locator=inj2)
         call fs1%add_bcond(name='inj3',type=dirichlet,face='z',dir=-1,canCorrect=.false.,locator=inj3)
         call fs1%add_bcond(name='inj4',type=dirichlet,face='z',dir=+1,canCorrect=.false.,locator=inj4)
         ! Outflow on the right
         call fs1%add_bcond(name='outflow',type=clipped_neumann,face='x',dir=+1,canCorrect=.true. ,locator=right_boundary)
         ! Configure pressure solver
         call param_read('Pressure iteration',fs1%psolv%maxit)
         call param_read('Pressure tolerance',fs1%psolv%rcvg)
         ! Configure implicit velocity solver
         call param_read('Implicit iteration',fs1%implicit%maxit)
         call param_read('Implicit tolerance',fs1%implicit%rcvg)
         ! Setup the solver
         call fs1%setup(pressure_ils=pcg_amg,implicit_ils=gmres)
      end block create_solver1

      ! Initialize our velocity field
      initialize_velocity1: block
         use mathtools, only: pi
         use incomp_class, only: bcond
         type(bcond), pointer :: mybc
         integer  :: n,i,j,k
         real(WP) :: rad,Uports
         real(WP) :: Q_SLPM,Q_SI,Aport
         real(WP), parameter :: SLPM2SI=1.66667E-5_WP
         ! Zero initial field
         fs1%U=0.0_WP; fs1%V=0.0_WP; fs1%W=0.0_WP
         ! Handle restart
         if (restarted) then
            call df1%pullvar(name='U'   ,var=fs1%U   )
            call df1%pullvar(name='V'   ,var=fs1%V   )
            call df1%pullvar(name='W'   ,var=fs1%W   )
            call df1%pullvar(name='P'   ,var=fs1%P   )
            call df1%pullvar(name='Uold',var=fs1%Uold)
            call df1%pullvar(name='Vold',var=fs1%Vold)
            call df1%pullvar(name='Wold',var=fs1%Wold)
         end if
         ! Read in mean gas
         call param_read('Gas flow rate (SLPM)',Q_SLPM)
         Q_SI=Q_SLPM*SLPM2SI
         Aport=pi/4.0_WP*inj_norm_diam**2
         Uports=Q_SI/(4.0_WP*Aport) ! fix here conversion
         ! Apply Dirichlet at 4 injector ports
         call fs1%get_bcond('inj1',mybc)
         do n=1,mybc%itr%no_
            i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n)
            fs1%V(i,j,k)=+Uports
         end do
         call fs1%get_bcond('inj2',mybc)
         do n=1,mybc%itr%no_
            i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n)
            fs1%V(i,j,k)=-Uports
         end do
         call fs1%get_bcond('inj3',mybc)
         do n=1,mybc%itr%no_
            i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n)
            fs1%W(i,j,k)=+Uports
         end do
         call fs1%get_bcond('inj4',mybc)
         do n=1,mybc%itr%no_
            i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n)
            fs1%W(i,j,k)=-Uports
         end do
         ! Apply all other boundary conditions
         call fs1%apply_bcond(time1%t,time1%dt)
         ! Compute MFR through all boundary conditions
         call fs1%get_mfr()
         ! Adjust MFR for global mass balance
         call fs1%correct_mfr()
         ! Compute cell-centered velocity
         call fs1%interp_vel(Ui1,Vi1,Wi1)
         ! Compute divergence
         call fs1%get_div()
      end block initialize_velocity1

      ! Create an LES model
      create_sgs1: block
         sgs1=sgsmodel(cfg=fs1%cfg,umask=fs1%umask,vmask=fs1%vmask,wmask=fs1%wmask)
         ! Handle restart
         if (restarted) then
            call df1%pullvar(name='LM',var=sgs1%LM)
            call df1%pullvar(name='MM',var=sgs1%MM)
         end if
      end block create_sgs1

      ! Add Ensight output
      create_ensight1: block
         ! Create Ensight output from cfg
         ens_out1=ensight(cfg1,'nozzle')
         ! Create event for Ensight output
         ens_evt1=event(time1,'Ensight output')
         call param_read('1 Ensight output period',ens_evt1%tper)
         ! Add variables to output
         call ens_out1%add_vector('velocity',Ui1,Vi1,Wi1)
         call ens_out1%add_scalar('visc_t',sgs1%visc)
         ! Output to ensight
         if (ens_evt1%occurs()) call ens_out1%write_data(time1%t)
      end block create_ensight1

      ! Create a monitor file
      create_monitor1: block
         ! Prepare some info about fields
         call fs1%get_cfl(time1%dt,time1%cfl)
         call fs1%get_max()
         ! Create simulation monitor
         mfile1=monitor(fs1%cfg%amRoot,'simulation1')
         call mfile1%add_column(time1%n,'Timestep number')
         call mfile1%add_column(time1%t,'Time')
         call mfile1%add_column(time1%dt,'Timestep size')
         call mfile1%add_column(time1%cfl,'Maximum CFL')
         call mfile1%add_column(fs1%Umax,'Umax')
         call mfile1%add_column(fs1%Vmax,'Vmax')
         call mfile1%add_column(fs1%Wmax,'Wmax')
         call mfile1%add_column(fs1%Pmax,'Pmax')
         call mfile1%add_column(fs1%divmax,'Maximum divergence')
         call mfile1%add_column(fs1%psolv%it,'Pressure iteration')
         call mfile1%add_column(fs1%psolv%rerr,'Pressure error')
         call mfile1%write()
         ! Create CFL monitor
         cflfile1=monitor(fs1%cfg%amRoot,'cfl1')
         call cflfile1%add_column(time1%n,'Timestep number')
         call cflfile1%add_column(time1%t,'Time')
         call cflfile1%add_column(fs1%CFLc_x,'Convective xCFL')
         call cflfile1%add_column(fs1%CFLc_y,'Convective yCFL')
         call cflfile1%add_column(fs1%CFLc_z,'Convective zCFL')
         call cflfile1%add_column(fs1%CFLv_x,'Viscous xCFL')
         call cflfile1%add_column(fs1%CFLv_y,'Viscous yCFL')
         call cflfile1%add_column(fs1%CFLv_z,'Viscous zCFL')
         call cflfile1%write()
      end block create_monitor1

      ! *****************************************************************************
      ! **************************** INITIALIZE SOLVER 3 ****************************
      ! *****************************************************************************

      ! Allocate work arrays for cfg3 solver
      allocate_work_arrays3: block
         allocate(resU3(cfg3%imino_:cfg3%imaxo_,cfg3%jmino_:cfg3%jmaxo_,cfg3%kmino_:cfg3%kmaxo_))
         allocate(resV3(cfg3%imino_:cfg3%imaxo_,cfg3%jmino_:cfg3%jmaxo_,cfg3%kmino_:cfg3%kmaxo_))
         allocate(resW3(cfg3%imino_:cfg3%imaxo_,cfg3%jmino_:cfg3%jmaxo_,cfg3%kmino_:cfg3%kmaxo_))
         allocate(Ui3  (cfg3%imino_:cfg3%imaxo_,cfg3%jmino_:cfg3%jmaxo_,cfg3%kmino_:cfg3%kmaxo_))
         allocate(Vi3  (cfg3%imino_:cfg3%imaxo_,cfg3%jmino_:cfg3%jmaxo_,cfg3%kmino_:cfg3%kmaxo_))
         allocate(Wi3  (cfg3%imino_:cfg3%imaxo_,cfg3%jmino_:cfg3%jmaxo_,cfg3%kmino_:cfg3%kmaxo_))
         allocate(SR3(6,cfg3%imino_:cfg3%imaxo_,cfg3%jmino_:cfg3%jmaxo_,cfg3%kmino_:cfg3%kmaxo_))
         allocate(U2on3(cfg3%imino_:cfg3%imaxo_,cfg3%jmino_:cfg3%jmaxo_,cfg3%kmino_:cfg3%kmaxo_))
         allocate(V2on3(cfg3%imino_:cfg3%imaxo_,cfg3%jmino_:cfg3%jmaxo_,cfg3%kmino_:cfg3%kmaxo_))
         allocate(W2on3(cfg3%imino_:cfg3%imaxo_,cfg3%jmino_:cfg3%jmaxo_,cfg3%kmino_:cfg3%kmaxo_))
      end block allocate_work_arrays3

      ! Initialize time tracker
      initialize_timetracker3: block
         time3=timetracker(cfg3%amRoot,name='spray_region')
         call param_read('3 Max timestep size',time3%dtmax)
         call param_read('3 Max cfl number',time3%cflmax)
         time3%dt=time3%dtmax
         time3%itmax=2
         ! Handle restart
         if (restarted) then
            call df3%pullval(name='t' ,val=time3%t )
            call df3%pullval(name='dt',val=time3%dt)
            time3%told=time3%t-time3%dt
         end if
      end block initialize_timetracker3

      ! Create an incompressible flow solver with bconds
      create_solver3: block
         use incomp_class, only: dirichlet,clipped_neumann
         use ils_class,    only: pcg_amg,gmres
         ! Create flow solver
         fs3=incomp(cfg=cfg3,name='Incompressible NS')
         ! Set the flow properties
         fs3%rho=fs2%rho_g
         fs3%visc=fs2%visc_g
         ! Define direction gas/liquid stream boundary conditions
         call fs3%add_bcond(name='gas_inj',type=dirichlet      ,face='x',dir=-1,canCorrect=.false.,locator=gas_inj_spray)
         ! Neumann on the side
         call fs3%add_bcond(name='bc_yp'  ,type=clipped_neumann,face='y',dir=+1,canCorrect=.true. ,locator=yp_locator)
         call fs3%add_bcond(name='bc_ym'  ,type=clipped_neumann,face='y',dir=-1,canCorrect=.true. ,locator=ym_locator)
         call fs3%add_bcond(name='bc_zp'  ,type=clipped_neumann,face='z',dir=+1,canCorrect=.true. ,locator=zp_locator)
         call fs3%add_bcond(name='bc_zm'  ,type=clipped_neumann,face='z',dir=-1,canCorrect=.true. ,locator=zm_locator)
         ! Outflow on the right
         call fs3%add_bcond(name='outflow',type=clipped_neumann,face='x',dir=+1,canCorrect=.true. ,locator=right_boundary)
         ! Configure pressure solver
         call param_read('Pressure iteration',fs3%psolv%maxit)
         call param_read('Pressure tolerance',fs3%psolv%rcvg)
         ! Configure implicit velocity solver
         call param_read('Implicit iteration',fs3%implicit%maxit)
         call param_read('Implicit tolerance',fs3%implicit%rcvg)
         ! Setup the solver
         call fs3%setup(pressure_ils=pcg_amg,implicit_ils=gmres)
      end block create_solver3

      ! Initialize our velocity field
      initialize_velocity3: block
         use mathtools, only: pi
         use incomp_class, only: bcond
         type(bcond), pointer :: mybc
         integer  :: n,i,j,k
         real(WP) :: rad,Uports
         real(WP) :: Q_SLPM,Q_SI,Aport
         real(WP), parameter :: SLPM2SI=1.66667E-5_WP
         ! Zero initial field
         fs3%U=0.0_WP; fs3%V=0.0_WP; fs3%W=0.0_WP
         ! Handle restart
         if (restarted) then
            call df3%pullvar(name='U'   ,var=fs3%U   )
            call df3%pullvar(name='V'   ,var=fs3%V   )
            call df3%pullvar(name='W'   ,var=fs3%W   )
            call df3%pullvar(name='P'   ,var=fs3%P   )
         end if
         ! Read in mean gas flow rate
         call param_read('Gas flow rate (SLPM)',Q_SLPM)
         Q_SI=Q_SLPM*SLPM2SI
         Aport=pi*rgi0_spray**2-pi*rlo0_spray**2
         Uports=Q_SI/Aport
         call fs3%get_bcond('gas_inj',mybc)
         do n=1,mybc%itr%no_
            i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n)
            fs3%U(i,j,k)=Uports
         end do
         ! Apply all other boundary conditions
         call fs3%apply_bcond(time3%t,time3%dt)
         ! Compute MFR through all boundary conditions
         call fs3%get_mfr()
         ! Adjust MFR for global mass balance
         call fs3%correct_mfr()
         ! Compute cell-centered velocity
         call fs3%interp_vel(Ui3,Vi3,Wi3)
         ! Compute divergence
         call fs3%get_div()
      end block initialize_velocity3

      ! Create an LES model
      create_sgs3: block
         sgs3=sgsmodel(cfg=fs3%cfg,umask=fs3%umask,vmask=fs3%vmask,wmask=fs3%wmask)
         ! Handle restart
         if (restarted) then
            call df3%pullvar(name='LM',var=sgs3%LM)
            call df3%pullvar(name='MM',var=sgs3%MM)
         end if
      end block create_sgs3

      ! Initialize our Lagrangian spray solver
      initialize_lpt3: block
         ! Create solver
         lp3=lpt(cfg=cfg3,name='spray')
         ! Get droplet density from the input
         call param_read('Liquid density',lp3%rho)
         ! Handle restarts
         if (restarted) call lp3%read(filename=trim(lpt_file))
         ! Also update the output
         call lp3%update_partmesh()
      end block initialize_lpt3

      ! Add Ensight output
      create_ensight3: block
         ! Create Ensight output from cfg
         ens_out3=ensight(cfg3,'spray')
         ! Create event for Ensight output
         ens_evt3=event(time3,'Ensight output')
         call param_read('3 Ensight output period',ens_evt3%tper)
         ! Add variables to output
         call ens_out3%add_vector('velocity',Ui3,Vi3,Wi3)
         call ens_out3%add_scalar('visc_t',sgs3%visc)
         call ens_out3%add_particle('spray',lp3%pmesh)
         ! Output to ensight
         if (ens_evt3%occurs()) call ens_out3%write_data(time3%t)
      end block create_ensight3

      ! Create a monitor file
      create_monitor3: block
         ! Prepare some info about fields
         call fs3%get_cfl(time3%dt,time3%cfl)
         call fs3%get_max()
         call lp3%get_max()
         ! Create simulation monitor
         mfile3=monitor(fs3%cfg%amRoot,'simulation3')
         call mfile3%add_column(time3%n,'Timestep number')
         call mfile3%add_column(time3%t,'Time')
         call mfile3%add_column(time3%dt,'Timestep size')
         call mfile3%add_column(time3%cfl,'Maximum CFL')
         call mfile3%add_column(fs3%Umax,'Umax')
         call mfile3%add_column(fs3%Vmax,'Vmax')
         call mfile3%add_column(fs3%Wmax,'Wmax')
         call mfile3%add_column(fs3%Pmax,'Pmax')
         call mfile3%add_column(fs3%divmax,'Maximum divergence')
         call mfile3%add_column(fs3%psolv%it,'Pressure iteration')
         call mfile3%add_column(fs3%psolv%rerr,'Pressure error')
         call mfile3%write()
         ! Create CFL monitor
         cflfile3=monitor(fs3%cfg%amRoot,'cfl3')
         call cflfile3%add_column(time3%n,'Timestep number')
         call cflfile3%add_column(time3%t,'Time')
         call cflfile3%add_column(fs3%CFLc_x,'Convective xCFL')
         call cflfile3%add_column(fs3%CFLc_y,'Convective yCFL')
         call cflfile3%add_column(fs3%CFLc_z,'Convective zCFL')
         call cflfile3%add_column(fs3%CFLv_x,'Viscous xCFL')
         call cflfile3%add_column(fs3%CFLv_y,'Viscous yCFL')
         call cflfile3%add_column(fs3%CFLv_z,'Viscous zCFL')
         call cflfile3%write()
         ! Create a spray monitor
         sprayfile=monitor(amroot=lp3%cfg%amRoot,name='spray')
         call sprayfile%add_column(time3%n,'Timestep number')
         call sprayfile%add_column(time3%t,'Time')
         call sprayfile%add_column(time3%dt,'Timestep size')
         call sprayfile%add_column(lp3%np,'Droplet number')
         call sprayfile%add_column(lp3%Umin, 'Umin')
         call sprayfile%add_column(lp3%Umax, 'Umax')
         call sprayfile%add_column(lp3%Umean,'Umean')
         call sprayfile%add_column(lp3%Vmin, 'Vmin')
         call sprayfile%add_column(lp3%Vmax, 'Vmax')
         call sprayfile%add_column(lp3%Vmean,'Vmean')
         call sprayfile%add_column(lp3%Wmin, 'Wmin')
         call sprayfile%add_column(lp3%Wmax, 'Wmax')
         call sprayfile%add_column(lp3%Wmean,'Wmean')
         call sprayfile%add_column(lp3%dmin, 'dmin')
         call sprayfile%add_column(lp3%dmax, 'dmax')
         call sprayfile%add_column(lp3%dmean,'dmean')
         call sprayfile%write()
      end block create_monitor3

   end subroutine simulation_init

   !> Perform an NGA2 simulation
   subroutine simulation_run
      use parallel,   only: MPI_REAL_WP
      use mpi_f08,    only: MPI_ALLREDUCE,MPI_SUM
      use tpns_class, only: bcond,static_contact
      implicit none
      integer :: n,i,j,k,ierr
      type(bcond), pointer :: mybc
      character(len=str_medium) :: dirname,timestamp

      ! Perform time integration - the second solver is the main driver here
      do while (.not.time2%done())

         ! Increment time
         call fs2%get_cfl(time2%dt,time2%cfl)
         call time2%adjust_dt()
         call time2%increment()

         ! ###############################################
         ! ############ ADVANCE SOLVER 1 HERE ############
         ! ###############################################

         ! Advance until we've caught up
         do while (time1%t.lt.time2%t)

            ! Increment time
            call fs1%get_cfl(time1%dt,time1%cfl)
            call time1%adjust_dt()
            call time1%increment()

            ! Remember old velocity
            fs1%Uold=fs1%U
            fs1%Vold=fs1%V
            fs1%Wold=fs1%W

            ! Apply time-varying Dirichlet conditions
            ! This is where time-dpt Dirichlet would be enforced

            ! Reset here fluid properties
            fs1%visc=fs2%visc_g

            ! Turbulence modeling
            call fs1%get_strainrate(Ui=Ui1,Vi=Vi1,Wi=Wi1,SR=SR1)
            resU1=fs1%rho
            call sgs1%get_visc(dt=time1%dtold,rho=resU1,Ui=Ui1,Vi=Vi1,Wi=Wi1,SR=SR1)
            where (sgs1%visc.lt.-fs1%visc)
               sgs1%visc=-fs1%visc
            end where
            fs1%visc=fs1%visc+sgs1%visc

            ! Perform sub-iterations
            do while (time1%it.le.time1%itmax)

               ! Build mid-time velocity
               fs1%U=0.5_WP*(fs1%U+fs1%Uold)
               fs1%V=0.5_WP*(fs1%V+fs1%Vold)
               fs1%W=0.5_WP*(fs1%W+fs1%Wold)

               ! Explicit calculation of drho*u/dt from NS
               call fs1%get_dmomdt(resU1,resV1,resW1)

               ! Assemble explicit residual
               resU1=-2.0_WP*(fs1%rho*fs1%U-fs1%rho*fs1%Uold)+time1%dt*resU1
               resV1=-2.0_WP*(fs1%rho*fs1%V-fs1%rho*fs1%Vold)+time1%dt*resV1
               resW1=-2.0_WP*(fs1%rho*fs1%W-fs1%rho*fs1%Wold)+time1%dt*resW1

               ! Form implicit residuals
               call fs1%solve_implicit(time1%dt,resU1,resV1,resW1)

               ! Apply these residuals
               fs1%U=2.0_WP*fs1%U-fs1%Uold+resU1
               fs1%V=2.0_WP*fs1%V-fs1%Vold+resV1
               fs1%W=2.0_WP*fs1%W-fs1%Wold+resW1

               ! Apply other boundary conditions on the resulting fields
               call fs1%apply_bcond(time1%t,time1%dt)

               ! Solve Poisson equation
               call fs1%correct_mfr()
               call fs1%get_div()
               fs1%psolv%rhs=-fs1%cfg%vol*fs1%div*fs1%rho/time1%dt
               fs1%psolv%sol=0.0_WP
               call fs1%psolv%solve()

               ! Correct velocity
               call fs1%get_pgrad(fs1%psolv%sol,resU1,resV1,resW1)
               fs1%P=fs1%P+fs1%psolv%sol
               fs1%U=fs1%U-time1%dt*resU1/fs1%rho
               fs1%V=fs1%V-time1%dt*resV1/fs1%rho
               fs1%W=fs1%W-time1%dt*resW1/fs1%rho

               ! Increment sub-iteration counter
               time1%it=time1%it+1

            end do

            ! Recompute interpolated velocity and divergence
            call fs1%interp_vel(Ui1,Vi1,Wi1)
            call fs1%get_div()

            ! Output to ensight
            if (ens_evt1%occurs()) call ens_out1%write_data(time1%t)

            ! Perform and output monitoring
            call fs1%get_max()
            call mfile1%write()
            call cflfile1%write()

         end do

         ! ###############################################
         ! ######## PERFORM ONE-WAY COUPLING HERE ########
         ! ###############################################
         first_coupling: block
            real(WP) :: wt
            ! At this point, we have ensured that t1>t2, therefore t2 is in [t1old,t1], so interpolate solver 1's velocity in time to t2
            wt=(time2%t-time1%told)/time1%dt
            resU1=wt*fs1%U+(1.0_WP-wt)*fs1%Uold
            resV1=wt*fs1%V+(1.0_WP-wt)*fs1%Vold
            resW1=wt*fs1%W+(1.0_WP-wt)*fs1%Wold
            ! Exchange data using cpl12x/y/z couplers
            call cpl12x%push(resU1); call cpl12x%transfer(); call cpl12x%pull(resU2)
            call cpl12y%push(resV1); call cpl12y%transfer(); call cpl12y%pull(resV2)
            call cpl12z%push(resW1); call cpl12z%transfer(); call cpl12z%pull(resW2)
            ! Apply time-varying Dirichlet conditions
            call fs2%get_bcond('gas_inj',mybc)
            do n=1,mybc%itr%no_
               i=mybc%itr%map(1,n); j=mybc%itr%map(2,n); k=mybc%itr%map(3,n)
               fs2%U(i  ,j,k)=resU2(i,j,k)
               fs2%V(i-1,j,k)=resV2(i,j,k)
               fs2%W(i-1,j,k)=resW2(i,j,k)
            end do
         end block first_coupling

         ! ###############################################
         ! ############ ADVANCE SOLVER 2 HERE ############
         ! ###############################################

         ! Remember old VOF
         vf2%VFold=vf2%VF

         ! Remember old velocity
         fs2%Uold=fs2%U
         fs2%Vold=fs2%V
         fs2%Wold=fs2%W

         ! Prepare old staggered density (at n)
         call fs2%get_olddensity(vf=vf2)

         ! VOF solver step
         call vf2%advance(dt=time2%dt,U=fs2%U,V=fs2%V,W=fs2%W)

         ! Prepare new staggered viscosity (at n+1)
         call fs2%get_viscosity(vf=vf2)

         ! Turbulence modeling - only work with gas properties here
         call fs2%get_strainrate(Ui=Ui2,Vi=Vi2,Wi=Wi2,SR=SR2)
         resU2=fs2%rho_g
         call sgs2%get_visc(dt=time2%dtold,rho=resU2,Ui=Ui2,Vi=Vi2,Wi=Wi2,SR=SR2)
         where (sgs2%visc.lt.-fs2%visc_g)
            sgs2%visc=-fs2%visc_g
         end where
         do k=fs2%cfg%kmino_+1,fs2%cfg%kmaxo_
            do j=fs2%cfg%jmino_+1,fs2%cfg%jmaxo_
               do i=fs2%cfg%imino_+1,fs2%cfg%imaxo_
                  fs2%visc(i,j,k)   =fs2%visc(i,j,k)   +sgs2%visc(i,j,k)
                  fs2%visc_xy(i,j,k)=fs2%visc_xy(i,j,k)+sum(fs2%itp_xy(:,:,i,j,k)*sgs2%visc(i-1:i,j-1:j,k))
                  fs2%visc_yz(i,j,k)=fs2%visc_yz(i,j,k)+sum(fs2%itp_yz(:,:,i,j,k)*sgs2%visc(i,j-1:j,k-1:k))
                  fs2%visc_zx(i,j,k)=fs2%visc_zx(i,j,k)+sum(fs2%itp_xz(:,:,i,j,k)*sgs2%visc(i-1:i,j,k-1:k))
               end do
            end do
         end do

         ! Perform sub-iterations
         do while (time2%it.le.time2%itmax)

            ! Build mid-time velocity
            fs2%U=0.5_WP*(fs2%U+fs2%Uold)
            fs2%V=0.5_WP*(fs2%V+fs2%Vold)
            fs2%W=0.5_WP*(fs2%W+fs2%Wold)

            ! Preliminary mass and momentum transport step at the interface
            call fs2%prepare_advection_upwind(dt=time2%dt)

            ! Explicit calculation of drho*u/dt from NS
            call fs2%get_dmomdt(resU2,resV2,resW2)

            ! Assemble explicit residual
            resU2=-2.0_WP*fs2%rho_U*fs2%U+(fs2%rho_Uold+fs2%rho_U)*fs2%Uold+time2%dt*resU2
            resV2=-2.0_WP*fs2%rho_V*fs2%V+(fs2%rho_Vold+fs2%rho_V)*fs2%Vold+time2%dt*resV2
            resW2=-2.0_WP*fs2%rho_W*fs2%W+(fs2%rho_Wold+fs2%rho_W)*fs2%Wold+time2%dt*resW2

            ! Form implicit residuals
            call fs2%solve_implicit(time2%dt,resU2,resV2,resW2)

            ! Apply these residuals
            fs2%U=2.0_WP*fs2%U-fs2%Uold+resU2
            fs2%V=2.0_WP*fs2%V-fs2%Vold+resV2
            fs2%W=2.0_WP*fs2%W-fs2%Wold+resW2

            ! Apply other boundary conditions
            call fs2%apply_bcond(time2%t,time2%dt)

            ! Solve Poisson equation
            call fs2%update_laplacian()
            call fs2%correct_mfr()
            call fs2%get_div()
            call fs2%add_surface_tension_jump(dt=time2%dt,div=fs2%div,vf=vf2,contact_model=static_contact)
            fs2%psolv%rhs=-fs2%cfg%vol*fs2%div/time2%dt
            fs2%psolv%sol=0.0_WP
            call fs2%psolv%solve()
            call fs2%shift_p(fs2%psolv%sol)

            ! Correct velocity
            call fs2%get_pgrad(fs2%psolv%sol,resU2,resV2,resW2)
            fs2%P=fs2%P+fs2%psolv%sol
            fs2%U=fs2%U-time2%dt*resU2/fs2%rho_U
            fs2%V=fs2%V-time2%dt*resV2/fs2%rho_V
            fs2%W=fs2%W-time2%dt*resW2/fs2%rho_W

            ! Increment sub-iteration counter
            time2%it=time2%it+1

         end do

         ! Recompute interpolated velocity and divergence
         call fs2%interp_vel(Ui2,Vi2,Wi2)
         call fs2%get_div()

         ! Output to ensight
         if (ens_evt2%occurs()) call ens_out2%write_data(time2%t)

         ! Perform and output monitoring
         call fs2%get_max()
         call vf2%get_max()
         call mfile2%write()
         call cflfile2%write()

         ! ###############################################
         ! ####### TRANSFER DROPLETS FROM 2->3 HERE ######
         ! ###############################################
         ! Perform CCL and transfer
         call transfer_vf_to_drops()
         ! After we're done clip all VOF at the exit area and along the sides - hopefully nothing's left
         do k=fs2%cfg%kmino_,fs2%cfg%kmaxo_
            do j=fs2%cfg%jmino_,fs2%cfg%jmaxo_
               do i=fs2%cfg%imino_,fs2%cfg%imaxo_
                  if (i.ge.vf2%cfg%imax-5) vf2%VF(i,j,k)=0.0_WP
                  if (j.ge.vf2%cfg%jmax-5) vf2%VF(i,j,k)=0.0_WP
                  if (j.le.vf2%cfg%jmin+5) vf2%VF(i,j,k)=0.0_WP
                  if (k.ge.vf2%cfg%kmax-5) vf2%VF(i,j,k)=0.0_WP
                  if (k.le.vf2%cfg%kmin+5) vf2%VF(i,j,k)=0.0_WP
               end do
            end do
         end do

         ! ###############################################
         ! ############ ADVANCE SOLVER 3 HERE ############
         ! ###############################################

         ! Advance until we've caught up
         do while (time3%t.lt.time2%t)

            ! ######################################
            ! ######## PREPARE NUDGING HERE ########
            ! ######################################
            ! Exchange data using cpl23x/y/z couplers and the most recent velocity
            U2on3=0.0_WP; call cpl23x%push(fs2%U); call cpl23x%transfer(); call cpl23x%pull(U2on3)
            V2on3=0.0_WP; call cpl23y%push(fs2%V); call cpl23y%transfer(); call cpl23y%pull(V2on3)
            W2on3=0.0_WP; call cpl23z%push(fs2%W); call cpl23z%transfer(); call cpl23z%pull(W2on3)

            ! Increment time
            call fs3%get_cfl(time3%dt,time3%cfl)
            call time3%adjust_dt()
            call time3%increment()

            ! Advance particles by full dt
            resU3=fs3%rho; resV3=fs2%visc_g
            call lp3%advance(dt=time3%dt,U=fs3%U,V=fs3%V,W=fs3%W,rho=resU3,visc=resV3)

            ! Remember old velocity
            fs3%Uold=fs3%U
            fs3%Vold=fs3%V
            fs3%Wold=fs3%W

            ! Apply time-varying Dirichlet conditions
            ! This is where time-dpt Dirichlet would be enforced

            ! Reset here fluid properties
            fs3%visc=fs2%visc_g

            ! Turbulence modeling
            call fs3%get_strainrate(Ui=Ui3,Vi=Vi3,Wi=Wi3,SR=SR3)
            resU3=fs3%rho
            call sgs3%get_visc(dt=time3%dtold,rho=resU3,Ui=Ui3,Vi=Vi3,Wi=Wi3,SR=SR3)
            where (sgs3%visc.lt.-fs3%visc)
               sgs3%visc=-fs3%visc
            end where
            fs3%visc=fs3%visc+sgs3%visc

            ! Perform sub-iterations
            do while (time3%it.le.time3%itmax)

               ! Build mid-time velocity
               fs3%U=0.5_WP*(fs3%U+fs3%Uold)
               fs3%V=0.5_WP*(fs3%V+fs3%Vold)
               fs3%W=0.5_WP*(fs3%W+fs3%Wold)

               ! Explicit calculation of drho*u/dt from NS
               call fs3%get_dmomdt(resU3,resV3,resW3)

               ! Assemble explicit residual
               resU3=-2.0_WP*(fs3%rho*fs3%U-fs3%rho*fs3%Uold)+time3%dt*resU3
               resV3=-2.0_WP*(fs3%rho*fs3%V-fs3%rho*fs3%Vold)+time3%dt*resV3
               resW3=-2.0_WP*(fs3%rho*fs3%W-fs3%rho*fs3%Wold)+time3%dt*resW3

               ! Add nudging term here
               nudge: block
                  real(WP) :: xcoord,ycoord,zcoord
                  do k=fs3%cfg%kmin_,fs3%cfg%kmax_
                     do j=fs3%cfg%jmin_,fs3%cfg%jmax_
                        do i=fs3%cfg%imin_,fs3%cfg%imax_
                           if (fs3%umask(i,j,k).eq.0) then
                              xcoord=max((fs2%cfg%x(fs2%cfg%imax+1)-    fs3%cfg%x (i) )/(fs2%cfg%x(fs2%cfg%imax+1)),0.0_WP)
                              ycoord=max((        0.5_WP*fs2%cfg%yL-abs(fs3%cfg%ym(j)))/(0.5_WP*fs2%cfg%yL        ),0.0_WP)
                              zcoord=max((        0.5_WP*fs2%cfg%zL-abs(fs3%cfg%zm(k)))/(0.5_WP*fs2%cfg%zL        ),0.0_WP)
                              resU3(i,j,k)=resU3(i,j,k)+(U2on3(i,j,k)-fs3%U(i,j,k))*(xcoord*ycoord*zcoord)**2
                           end if
                           if (fs3%vmask(i,j,k).eq.0) then
                              xcoord=max((fs2%cfg%x(fs2%cfg%imax+1)-    fs3%cfg%xm(i) )/(fs2%cfg%x(fs2%cfg%imax+1)),0.0_WP)
                              ycoord=max((        0.5_WP*fs2%cfg%yL-abs(fs3%cfg%y (j)))/(0.5_WP*fs2%cfg%yL        ),0.0_WP)
                              zcoord=max((        0.5_WP*fs2%cfg%zL-abs(fs3%cfg%zm(k)))/(0.5_WP*fs2%cfg%zL        ),0.0_WP)
                              resV3(i,j,k)=resV3(i,j,k)+(V2on3(i,j,k)-fs3%V(i,j,k))*(xcoord*ycoord*zcoord)**2
                           end if
                           if (fs3%wmask(i,j,k).eq.0) then
                              xcoord=max((fs2%cfg%x(fs2%cfg%imax+1)-    fs3%cfg%xm(i) )/(fs2%cfg%x(fs2%cfg%imax+1)),0.0_WP)
                              ycoord=max((        0.5_WP*fs2%cfg%yL-abs(fs3%cfg%ym(j)))/(0.5_WP*fs2%cfg%yL        ),0.0_WP)
                              zcoord=max((        0.5_WP*fs2%cfg%zL-abs(fs3%cfg%z (k)))/(0.5_WP*fs2%cfg%zL        ),0.0_WP)
                              resW3(i,j,k)=resW3(i,j,k)+(W2on3(i,j,k)-fs3%W(i,j,k))*(xcoord*ycoord*zcoord)**2
                           end if
                        end do
                     end do
                  end do
               end block nudge

               ! Form implicit residuals
               call fs3%solve_implicit(time3%dt,resU3,resV3,resW3)

               ! Apply these residuals
               fs3%U=2.0_WP*fs3%U-fs3%Uold+resU3
               fs3%V=2.0_WP*fs3%V-fs3%Vold+resV3
               fs3%W=2.0_WP*fs3%W-fs3%Wold+resW3

               ! Apply other boundary conditions on the resulting fields
               call fs3%apply_bcond(time3%t,time3%dt)

               ! Solve Poisson equation
               call fs3%correct_mfr()
               call fs3%get_div()
               fs3%psolv%rhs=-fs3%cfg%vol*fs3%div*fs3%rho/time3%dt
               fs3%psolv%sol=0.0_WP
               call fs3%psolv%solve()

               ! Correct velocity
               call fs3%get_pgrad(fs3%psolv%sol,resU3,resV3,resW3)
               fs3%P=fs3%P+fs3%psolv%sol
               fs3%U=fs3%U-time3%dt*resU3/fs3%rho
               fs3%V=fs3%V-time3%dt*resV3/fs3%rho
               fs3%W=fs3%W-time3%dt*resW3/fs3%rho

               ! Increment sub-iteration counter
               time3%it=time3%it+1

            end do

            ! Recompute interpolated velocity and divergence
            call fs3%interp_vel(Ui3,Vi3,Wi3)
            call fs3%get_div()

            ! Output to ensight
            if (ens_evt3%occurs()) call ens_out3%write_data(time3%t)

            ! Perform and output monitoring
            call fs3%get_max()
            call lp3%get_max()
            call mfile3%write()
            call cflfile3%write()
            call sprayfile%write()

         end do

         ! ###############################################
         ! ############## PERFORM I/O HERE ###############
         ! ###############################################

         ! Finally, see if it's time to save restart files
         if (save_evt%occurs()) then
            ! Prefix for files
            dirname='restart_'; write(timestamp,'(es12.5)') time2%t
            ! Prepare a new directory
            if (fs1%cfg%amRoot) call execute_command_line('mkdir -p '//trim(adjustl(dirname))//trim(adjustl(timestamp)))
            ! Populate df1 and write it
            call df1%pushval(name=   't',val=time1%t )
            call df1%pushval(name=  'dt',val=time1%dt)
            call df1%pushvar(name=   'U',var=fs1%U   )
            call df1%pushvar(name=   'V',var=fs1%V   )
            call df1%pushvar(name=   'W',var=fs1%W   )
            call df1%pushvar(name=   'P',var=fs1%P   )
            call df1%pushvar(name='Uold',var=fs1%Uold)
            call df1%pushvar(name='Vold',var=fs1%Vold)
            call df1%pushvar(name='Wold',var=fs1%Wold)
            call df1%pushvar(name=  'LM',var=sgs1%LM )
            call df1%pushvar(name=  'MM',var=sgs1%MM )
            call df1%write(fdata=trim(adjustl(dirname))//trim(adjustl(timestamp))//'/'//'data.1')
            ! Populate df2 and write it
            call df2%pushval(name=  't',val=time2%t )
            call df2%pushval(name= 'dt',val=time2%dt)
            call df2%pushvar(name=  'U',var=fs2%U   )
            call df2%pushvar(name=  'V',var=fs2%V   )
            call df2%pushvar(name=  'W',var=fs2%W   )
            call df2%pushvar(name=  'P',var=fs2%P   )
            call df2%pushvar(name='Pjx',var=fs2%Pjx )
            call df2%pushvar(name='Pjy',var=fs2%Pjy )
            call df2%pushvar(name='Pjz',var=fs2%Pjz )
            call df2%pushvar(name= 'LM',var=sgs2%LM )
            call df2%pushvar(name= 'MM',var=sgs2%MM )
            call df2%pushvar(name= 'VF',var=vf2%VF  )
            call df2%write(fdata=trim(adjustl(dirname))//trim(adjustl(timestamp))//'/'//'data.2')
            ! Also output IRL interface
            call vf2%write_interface(filename=trim(adjustl(dirname))//trim(adjustl(timestamp))//'/'//'data.irl')
            ! Populate df3 and write it
            call df3%pushval(name=   't',val=time3%t )
            call df3%pushval(name=  'dt',val=time3%dt)
            call df3%pushvar(name=   'U',var=fs3%U   )
            call df3%pushvar(name=   'V',var=fs3%V   )
            call df3%pushvar(name=   'W',var=fs3%W   )
            call df3%pushvar(name=   'P',var=fs3%P   )
            call df3%pushvar(name=  'LM',var=sgs3%LM )
            call df3%pushvar(name=  'MM',var=sgs3%MM )
            call df3%write(fdata=trim(adjustl(dirname))//trim(adjustl(timestamp))//'/'//'data.3')
            ! Also output particles
            call lp3%write(filename=trim(adjustl(dirname))//trim(adjustl(timestamp))//'/'//'data.lpt')
         end if

      end do

   end subroutine simulation_run

   !> Transfer vf to drops
   subroutine transfer_vf_to_drops()
      implicit none

      ! Perform a first pass with simplest CCL
      call cc2%build_lists(VF=vf2%VF,U=fs2%U,V=fs2%V,W=fs2%W)

      ! Loop through identified detached structs and remove those that are spherical enough
      remove_struct: block
         use mathtools, only: pi
         integer :: m,n,l,i,j,k,np
         real(WP) :: lmin,lmax,eccentricity,diam

         ! Loops over film segments contained locally
         do m=1,cc2%n_meta_struct

            ! Test if sphericity is compatible with transfer
            lmin=cc2%meta_structures_list(m)%lengths(3)
            if (lmin.eq.0.0_WP) lmin=cc2%meta_structures_list(m)%lengths(2) ! Handle 2D case
            lmax=cc2%meta_structures_list(m)%lengths(1)
            eccentricity=sqrt(1.0_WP-lmin**2/lmax**2)
            if (eccentricity.gt.max_eccentricity) cycle

            ! Test if diameter is compatible with transfer
            diam=(6.0_WP*cc2%meta_structures_list(m)%vol/pi)**(1.0_WP/3.0_WP)
            if (diam.eq.0.0_WP.or.diam.gt.d_threshold) cycle

            ! Create drop from available liquid volume - only one root does that
            if (cc2%cfg%amRoot) then
               ! Make room for new drop
               np=lp3%np_+1; call lp3%resize(np)
               ! Add the drop
               lp3%p(np)%id  =int(0,8)                                                                                !< Give id (maybe based on break-up model?)
               lp3%p(np)%dt  =0.0_WP                                                                                !< Let the drop find it own integration time
               lp3%p(np)%d   =diam                                                                                !< Assign diameter to account for full volume
               lp3%p(np)%pos =[cc2%meta_structures_list(m)%x,cc2%meta_structures_list(m)%y,cc2%meta_structures_list(m)%z]   !< Place the drop at the liquid barycenter
               lp3%p(np)%vel =[cc2%meta_structures_list(m)%u,cc2%meta_structures_list(m)%v,cc2%meta_structures_list(m)%w]   !< Assign mean structure velocity as drop velocity
               lp3%p(np)%ind =lp3%cfg%get_ijk_global(lp3%p(np)%pos,[lp3%cfg%imin,lp3%cfg%jmin,lp3%cfg%kmin])                !< Place the drop in the proper cell for the lp%cfg
               lp3%p(np)%flag=0                                                                                !< Activate it
               ! Increment particle counter
               lp3%np_=np
            end if

            ! Find local structs with matching id
            do n=cc2%sync_offset+1,cc2%sync_offset+cc2%n_struct
               if (cc2%struct_list(cc2%struct_map_(n))%parent.ne.cc2%meta_structures_list(m)%id) cycle
               ! Remove liquid in meta-structure cells
               do l=1,cc2%struct_list(cc2%struct_map_(n))%nnode ! Loops over cells within local
                  i=cc2%struct_list(cc2%struct_map_(n))%node(1,l)
                  j=cc2%struct_list(cc2%struct_map_(n))%node(2,l)
                  k=cc2%struct_list(cc2%struct_map_(n))%node(3,l)
                  ! Remove liquid in that cell
                  vf2%VF(i,j,k)=0.0_WP
               end do
            end do

         end do

      end block remove_struct

      ! Sync VF and clean up IRL and band
      call vf2%cfg%sync(vf2%VF)
      call vf2%clean_irl_and_band()

      ! Clean up CCL
      call cc2%deallocate_lists()

      ! Perform more detailed CCL in a second pass
      cc2%max_interface_planes=2
      call cc2%build_lists(VF=vf2%VF,poly=vf2%interface_polygon,U=fs2%U,V=fs2%V,W=fs2%W)
      call cc2%get_min_thickness()
      call cc2%sort_by_thickness()

      ! Loop through identified films and remove those that are thin enough
      remove_film: block
         use mathtools, only: pi
         integer :: m,n,i,j,k,np,ip,np_old
         real(WP) :: Vt,Vl,Hl,Vd

         ! Loops over film segments contained locally
         do m=cc2%film_sync_offset+1,cc2%film_sync_offset+cc2%n_film

            ! Skip non-liquid films
            if (cc2%film_list(cc2%film_map_(m))%phase.ne.1) cycle

            ! Skip films that are still thick enough
            if (cc2%film_list(cc2%film_map_(m))%min_thickness.gt.min_filmthickness) cycle

            ! We are still here: transfer the film to drops
            Vt=0.0_WP       ! Transferred volume
            Vl=0.0_WP       ! We will keep track incrementally of the liquid volume to transfer to ensure conservation
            np_old=lp3%np_  ! Remember old number of particles
            do n=1,cc2%film_list(cc2%film_map_(m))%nnode ! Loops over cells within local film segment
               i=cc2%film_list(cc2%film_map_(m))%node(1,n)
               j=cc2%film_list(cc2%film_map_(m))%node(2,n)
               k=cc2%film_list(cc2%film_map_(m))%node(3,n)
               ! Increment liquid volume to remove
               Vl=Vl+vf2%VF(i,j,k)*vf2%cfg%vol(i,j,k)
               ! Estimate drop size based on local film thickness in current cell
               Hl=max(cc2%film_thickness(i,j,k),min_filmthickness)
               Vd=pi/6.0_WP*(diam_over_filmthickness*Hl)**3
               ! Create drops from available liquid volume
               do while (Vl-Vd.gt.0.0_WP)
                  ! Make room for new drop
                  np=lp3%np_+1; call lp3%resize(np)
                  ! Add the drop
                  lp3%p(np)%id  =int(0,8)                                   !< Give id (maybe based on break-up model?)
                  lp3%p(np)%dt  =0.0_WP                                     !< Let the drop find it own integration time
                  lp3%p(np)%d   =(6.0_WP*Vd/pi)**(1.0_WP/3.0_WP)            !< Assign diameter from model above
                  lp3%p(np)%pos =vf2%Lbary(:,i,j,k)                         !< Place the drop at the liquid barycenter
                  lp3%p(np)%vel =fs2%cfg%get_velocity(pos=lp3%p(np)%pos,i0=i,j0=j,k0=k,U=fs2%U,V=fs2%V,W=fs2%W) !< Interpolate local cell velocity as drop velocity
                  lp3%p(np)%ind =lp3%cfg%get_ijk_global(lp3%p(np)%pos,[lp3%cfg%imin,lp3%cfg%jmin,lp3%cfg%kmin]) !< Place the drop in the proper cell for the lp%cfg
                  lp3%p(np)%flag=0                                          !< Activate it
                  ! Increment particle counter
                  lp3%np_=np
                  ! Update tracked volumes
                  Vl=Vl-Vd
                  Vt=Vt+Vd
               end do
               ! Remove liquid in that cell
               vf2%VF(i,j,k)=0.0_WP
            end do

            ! Based on how many particles were created, decide what to do with left-over volume
            if (Vt.eq.0.0_WP) then ! No particle was created, we need one...
               ! Add one last drop for remaining liquid volume
               np=lp3%np_+1; call lp3%resize(np)
               ! Add the drop
               lp3%p(np)%id  =int(0,8)                                   !< Give id (maybe based on break-up model?)
               lp3%p(np)%dt  =0.0_WP                                     !< Let the drop find it own integration time
               lp3%p(np)%d   =(6.0_WP*Vl/pi)**(1.0_WP/3.0_WP)            !< Assign diameter based on remaining liquid volume
               lp3%p(np)%pos =vf2%Lbary(:,i,j,k)                         !< Place the drop at the liquid barycenter
               lp3%p(np)%vel =fs2%cfg%get_velocity(pos=lp3%p(np)%pos,i0=i,j0=j,k0=k,U=fs2%U,V=fs2%V,W=fs2%W) !< Interpolate local cell velocity as drop velocity
               lp3%p(np)%ind =lp3%cfg%get_ijk_global(lp3%p(np)%pos,[lp3%cfg%imin,lp3%cfg%jmin,lp3%cfg%kmin]) !< Place the drop in the proper cell for the lp%cfg
               lp3%p(np)%flag=0                                          !< Activate it
               ! Increment particle counter
               lp3%np_=np
            else ! Some particles were created, make them all larger
               do ip=np_old+1,lp3%np_
                  lp3%p(ip)%d=lp3%p(ip)%d*((Vt+Vl)/Vt)**(1.0_WP/3.0_WP)
               end do
            end if
         end do

      end block remove_film

      ! Sync VF and clean up IRL and band
      call vf2%cfg%sync(vf2%VF)
      call vf2%clean_irl_and_band()
      call vf2%update_surfgrid()

      ! Clean up CCL
      call cc2%deallocate_lists()

      ! Resync the spray
      call lp3%sync()

      ! Update the particle mesh
      call lp3%update_partmesh()

   end subroutine transfer_vf_to_drops

   !> Finalize the NGA2 simulation
   subroutine simulation_final
      implicit none

      ! Get rid of all objects - need destructors
      ! monitor
      ! ensight
      ! bcond
      ! timetracker

      ! Deallocate work arrays
      deallocate(resU1,resV1,resW1,Ui1,Vi1,Wi1,SR1)
      deallocate(resU2,resV2,resW2,Ui2,Vi2,Wi2,SR2)
      deallocate(resU3,resV3,resW3,Ui3,Vi3,Wi3,SR3,U2on3,V2on3,W2on3)

   end subroutine simulation_final

end module simulation