source: LMDZ6/branches/Amaury_dev/libf/dyn3d/integrd.F90 @ 5186

! $Id: integrd.F90 5159 2024-08-02 19:58:25Z abarral $

SUBROUTINE integrd &
        (nq, vcovm1, ucovm1, tetam1, psm1, massem1, &
        dv, du, dteta, dq, dp, vcov, ucov, teta, q, ps, masse, phis & !,finvmaold
        )

  USE control_mod, ONLY: planet_type
  USE comconst_mod, ONLY: pi
  USE logic_mod, ONLY: leapf
  USE comvert_mod, ONLY: ap, bp
  USE temps_mod, ONLY: dt
  USE lmdz_iniprint, ONLY: lunout, prt_level
  USE lmdz_ssum_scopy, ONLY: scopy, ssum
  USE lmdz_comgeom

  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
  USE lmdz_paramet
  IMPLICIT NONE


  !=======================================================================

  !   Auteur:  P. Le Van
  !   -------

  !   objet:
  !   ------

  !   Incrementation des tendances dynamiques

  !=======================================================================
  !-----------------------------------------------------------------------
  !   Declarations:
  !   -------------




  !   Arguments:
  !   ----------

  INTEGER, INTENT(IN) :: nq ! number of tracers to handle in this routine
  REAL, INTENT(INOUT) :: vcov(ip1jm, llm) ! covariant meridional wind
  REAL, INTENT(INOUT) :: ucov(ip1jmp1, llm) ! covariant zonal wind
  REAL, INTENT(INOUT) :: teta(ip1jmp1, llm) ! potential temperature
  REAL, INTENT(INOUT) :: q(ip1jmp1, llm, nq) ! advected tracers
  REAL, INTENT(INOUT) :: ps(ip1jmp1) ! surface pressure
  REAL, INTENT(INOUT) :: masse(ip1jmp1, llm) ! atmospheric mass
  REAL, INTENT(IN) :: phis(ip1jmp1) ! ground geopotential !!! unused
  ! values at previous time step
  REAL, INTENT(INOUT) :: vcovm1(ip1jm, llm)
  REAL, INTENT(INOUT) :: ucovm1(ip1jmp1, llm)
  REAL, INTENT(INOUT) :: tetam1(ip1jmp1, llm)
  REAL, INTENT(INOUT) :: psm1(ip1jmp1)
  REAL, INTENT(INOUT) :: massem1(ip1jmp1, llm)
  ! the tendencies to add
  REAL, INTENT(IN) :: dv(ip1jm, llm)
  REAL, INTENT(IN) :: du(ip1jmp1, llm)
  REAL, INTENT(IN) :: dteta(ip1jmp1, llm)
  REAL, INTENT(IN) :: dp(ip1jmp1)
  REAL, INTENT(IN) :: dq(ip1jmp1, llm, nq) !!! unused
  ! REAL,INTENT(OUT) :: finvmaold(ip1jmp1,llm) !!! unused

  !   Local:
  !   ------

  REAL :: vscr(ip1jm), uscr(ip1jmp1), hscr(ip1jmp1), pscr(ip1jmp1)
  REAL :: massescr(ip1jmp1, llm)
  ! REAL finvmasse(ip1jmp1,llm)
  REAL :: p(ip1jmp1, llmp1)
  REAL :: tpn, tps, tppn(iim), tpps(iim)
  REAL :: qpn, qps, qppn(iim), qpps(iim)
  REAL :: deltap(ip1jmp1, llm)

  INTEGER :: l, ij, iq, i, j

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

  DO  l = 1, llm
    DO  ij = 1, iip1
      ucov(ij, l) = 0.
      ucov(ij + ip1jm, l) = 0.
      uscr(ij) = 0.
      uscr(ij + ip1jm) = 0.
    ENDDO
  ENDDO


  !    ............    integration  de       ps         ..............

  CALL SCOPY(ip1jmp1 * llm, masse, 1, massescr, 1)

  DO ij = 1, ip1jmp1
    pscr (ij) = ps(ij)
    ps (ij) = psm1(ij) + dt * dp(ij)
  ENDDO

  DO ij = 1, ip1jmp1
    IF(ps(ij)<0.) THEN
      WRITE(lunout, *) "integrd: negative surface pressure ", ps(ij)
      WRITE(lunout, *) " at node ij =", ij
      ! since ij=j+(i-1)*jjp1 , we have
      j = modulo(ij, jjp1)
      i = 1 + (ij - j) / jjp1
      WRITE(lunout, *) " lon = ", rlonv(i) * 180. / pi, " deg", &
              " lat = ", rlatu(j) * 180. / pi, " deg"
      CALL abort_gcm("integrd", "", 1)
    ENDIF
  ENDDO

  DO  ij = 1, iim
    tppn(ij) = aire(ij) * ps(ij)
    tpps(ij) = aire(ij + ip1jm) * ps(ij + ip1jm)
  ENDDO
  tpn = SSUM(iim, tppn, 1) / apoln
  tps = SSUM(iim, tpps, 1) / apols
  DO ij = 1, iip1
    ps(ij) = tpn
    ps(ij + ip1jm) = tps
  ENDDO

  !  ... Calcul  de la nouvelle masse d'air au dernier temps integre t+1 ...

  CALL pression (ip1jmp1, ap, bp, ps, p)
  CALL massdair (p, masse)

  ! Ehouarn : we don't use/need finvmaold and finvmasse,
  ! so might as well not compute them
  ! CALL   SCOPY( ijp1llm  , masse, 1, finvmasse,  1      )
  ! CALL filtreg( finvmasse, jjp1, llm, -2, 2, .TRUE., 1  )
  !

  !    ............   integration  de  ucov, vcov,  h     ..............

  DO l = 1, llm

    DO ij = iip2, ip1jm
      uscr(ij) = ucov(ij, l)
      ucov(ij, l) = ucovm1(ij, l) + dt * du(ij, l)
    ENDDO

    DO ij = 1, ip1jm
      vscr(ij) = vcov(ij, l)
      vcov(ij, l) = vcovm1(ij, l) + dt * dv(ij, l)
    ENDDO

    DO ij = 1, ip1jmp1
      hscr(ij) = teta(ij, l)
      teta (ij, l) = tetam1(ij, l) * massem1(ij, l) / masse(ij, l) &
              + dt * dteta(ij, l) / masse(ij, l)
    ENDDO

    !   ....  Calcul de la valeur moyenne, unique  aux poles pour  teta    ......


    DO  ij = 1, iim
      tppn(ij) = aire(ij) * teta(ij, l)
      tpps(ij) = aire(ij + ip1jm) * teta(ij + ip1jm, l)
    ENDDO
    tpn = SSUM(iim, tppn, 1) / apoln
    tps = SSUM(iim, tpps, 1) / apols

    DO ij = 1, iip1
      teta(ij, l) = tpn
      teta(ij + ip1jm, l) = tps
    ENDDO
    !

    IF(leapf)  THEN
      CALL SCOPY (ip1jmp1, uscr(1), 1, ucovm1(1, l), 1)
      CALL SCOPY (ip1jm, vscr(1), 1, vcovm1(1, l), 1)
      CALL SCOPY (ip1jmp1, hscr(1), 1, tetam1(1, l), 1)
    END IF

  ENDDO ! of DO l = 1,llm



  !   .......  integration de   q   ......

  !$$$      IF( iadv(1).NE.3.AND.iadv(2).NE.3 )    THEN
  !$$$c
  !$$$       IF( forward .OR.  leapf )  THEN
  !$$$        DO iq = 1,2
  !$$$        DO  l = 1,llm
  !$$$        DO ij = 1,ip1jmp1
  !$$$        q(ij,l,iq) = ( q(ij,l,iq)*finvmaold(ij,l) + dtvr *dq(ij,l,iq) )/
  !$$$     $                            finvmasse(ij,l)
  !$$$        ENDDO
  !$$$        ENDDO
  !$$$        ENDDO
  !$$$       ELSE
  !$$$         DO iq = 1,2
  !$$$         DO  l = 1,llm
  !$$$         DO ij = 1,ip1jmp1
  !$$$         q( ij,l,iq ) = q( ij,l,iq ) * finvmaold(ij,l) / finvmasse(ij,l)
  !$$$         ENDDO
  !$$$         ENDDO
  !$$$         ENDDO
  !$$$
  !$$$       END IF
  !$$$c
  !$$$      ENDIF

  IF (planet_type=="earth") THEN
    ! Earth-specific treatment of first 2 tracers (water)
    DO l = 1, llm
      DO ij = 1, ip1jmp1
        deltap(ij, l) = p(ij, l) - p(ij, l + 1)
      ENDDO
    ENDDO

    CALL qminimum(q, nq, deltap)


    !    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
    !

    DO iq = 1, nq
      DO l = 1, llm

        DO ij = 1, iim
          qppn(ij) = aire(ij) * q(ij, l, iq)
          qpps(ij) = aire(ij + ip1jm) * q(ij + ip1jm, l, iq)
        ENDDO
        qpn = SSUM(iim, qppn, 1) / apoln
        qps = SSUM(iim, qpps, 1) / apols

        DO ij = 1, iip1
          q(ij, l, iq) = qpn
          q(ij + ip1jm, l, iq) = qps
        ENDDO

      ENDDO
    ENDDO

    ! Ehouarn: forget about finvmaold
    ! CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )

  ENDIF ! of if (planet_type.EQ."earth")


  ! .....   FIN  de l'integration  de   q    .......

  !    .................................................................

  IF(leapf)  THEN
    CALL SCOPY (ip1jmp1, pscr, 1, psm1, 1)
    CALL SCOPY (ip1jmp1 * llm, massescr, 1, massem1, 1)
  END IF

END SUBROUTINE integrd