source: codes/icosagcm/devel/src/diagnostics/compute_vorticity.F90 @ 1057

MODULE compute_vorticity_mod
  USE grid_param
  USE prec, ONLY : rstd
  IMPLICIT NONE
  PRIVATE

#include "../unstructured/unstructured.h90"

  PUBLIC :: vorticity, compute_vorticity_manual, compute_vorticity_hex, compute_vorticity_unst

CONTAINS

#ifdef BEGIN_DYSL

KERNEL(compute_vorticity)

  FORALL_CELLS_EXT()
    ON_DUAL
      etav = 0.d0
      FORALL_EDGES
         etav = etav + SIGN*ue(EDGE)*DE
      END_BLOCK
      vort(DUAL_CELL) = etav / AV
    END_BLOCK

  END_BLOCK

END_BLOCK

#endif END_DYSL

  SUBROUTINE vorticity(f_ue,f_vort)
    USE icosa
    USE compute_diagnostics_mod, ONLY : compute_vorticity
    TYPE(t_field), POINTER :: f_ue(:)
    TYPE(t_field), POINTER :: f_vort(:)
  
    REAL(rstd), POINTER :: ue(:,:)
    REAL(rstd), POINTER :: vort(:,:)
    INTEGER :: ind

    CALL transfert_request(f_ue,req_e1_vect)
   
    DO ind=1,ndomain
      IF (.NOT. assigned_domain(ind)) CYCLE
      CALL swap_dimensions(ind)
      CALL swap_geometry(ind)
      ue=f_ue(ind)
      vort=f_vort(ind)
      CALL compute_vorticity(ue, vort)
    ENDDO
  
  END SUBROUTINE vorticity

!-------------- Wrappers for F2008 conformity -----------------

  SUBROUTINE compute_vorticity_unst(ue,vort)
    REAL(rstd),INTENT(IN)  :: ue(:,:)
    REAL(rstd),INTENT(OUT) :: vort(:,:)
    CALL compute_vorticity_unst_(ue,vort)
  END SUBROUTINE compute_vorticity_unst

  SUBROUTINE compute_vorticity_hex(ue,vort)
    REAL(rstd),INTENT(IN)  :: ue(:,:)
    REAL(rstd),INTENT(OUT) :: vort(:,:)
    CALL compute_vorticity_hex_(ue,vort)
  END SUBROUTINE compute_vorticity_hex

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

  SUBROUTINE compute_vorticity_unst_(ue,vort)
    USE ISO_C_BINDING, only : C_DOUBLE, C_FLOAT
    USE geometry, ONLY : de, Av
    USE data_unstructured_mod, ONLY : dual_deg, dual_edge, dual_ne
    FIELD_U    :: ue
    FIELD_Z    :: vort
    DECLARE_INDICES
    DECLARE_EDGES
    DECLARE_VERTICES
    NUM :: etav
#include "../kernels_unst/compute_vorticity.k90"
  END SUBROUTINE compute_vorticity_unst_

  SUBROUTINE compute_vorticity_hex_(ue,vort)
    USE icosa
    USE omp_para
    REAL(rstd),INTENT(IN)  :: ue(3*iim*jjm,llm)
    REAL(rstd),INTENT(OUT) :: vort(2*iim*jjm,llm)
    REAL(rstd) :: etav
    INTEGER :: ij,l

#include "../kernels_hex/compute_vorticity.k90"
  END SUBROUTINE compute_vorticity_hex_

  SUBROUTINE compute_vorticity_manual(ue,vort)
  USE icosa
  USE disvert_mod
  USE omp_para
  IMPLICIT NONE
    REAL(rstd),INTENT(IN)  :: ue(3*iim*jjm,llm)
    REAL(rstd),INTENT(OUT) :: vort(2*iim*jjm,llm)
    INTEGER :: i,j,ij,l

    DO l = ll_begin,ll_end
      DO j=jj_begin-1,jj_end+1
        DO i=ii_begin-1,ii_end+1
          ij=(j-1)*iim+i
        
           vort(ij+z_up,l) = 1./Av(ij+z_up)*(  ne(ij,rup)        * ue(ij+u_rup,l)        * de(ij+u_rup)         &
                                + ne(ij+t_rup,left) * ue(ij+t_rup+u_left,l) * de(ij+t_rup+u_left)               &
                                - ne(ij,lup)        * ue(ij+u_lup,l)        * de(ij+u_lup) )                               

           vort(ij+z_down,l) = 1./Av(ij+z_down)*(  ne(ij,ldown)         * ue(ij+u_ldown,l)         * de(ij+u_ldown)          &
                                   + ne(ij+t_ldown,right) * ue(ij+t_ldown+u_right,l) * de(ij+t_ldown+u_right)                &
                                   - ne(ij,rdown)         * ue(ij+u_rdown,l)          * de(ij+u_rdown) )

        ENDDO
      ENDDO
    ENDDO
    
  END SUBROUTINE compute_vorticity_manual

END MODULE compute_vorticity_mod