! (C) Copyright 2001- ECMWF. ! (C) Copyright 2001- Meteo-France. ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. ! SUBROUTINE INV_TRANS_FIELD_API(KRESOL, & & YDFSPSCALAR, YDFSPVOR,YDFSPDIV, & & YDFSCALAR, YDFU, YDFV, & & YDFVOR,YDFDIV, & & YDFSCALAR_NS, YDFSCALAR_EW, YDFU_EW, YDFV_EW, & & FSPGL_PROC) !**** *INV_TRANS_FIELD_API* - Field API interface to inverse spectral transform ! Purpose. ! -------- ! Allow to call INV_TRANS with a list of fields from field API !** Interface. ! ---------- ! CALL INV_TRANS_FIELD_API(...) ! Explicit arguments : ! -------------------- ! input ! KRESOL - The resolution identifier ! YDFSPSCALAR(:) - List of spectral scalar fields ! YDFSPVOR(:) - List of spectral vector fields (vorticity) ! YDFSPDIV(:) - List of spectral vector fields (divergence) ! FSPGL_PROC - procedure to be executed in fourier space ! before transposition ! output ! YDFSCALAR(:) - List of grid-point scalar fields ! YDFU(:) - List of grid-point vector fields (u) ! YDFV(:) - List of grid-point vector fields (v) ! YDFVOR(:) - List of grid-point vector fields (vorticity) ! YDFDIV(:) - List of grid-point vector fields (divergence) ! YDFSCALAR_NS(:) - List of grid-point scalar fields derivatives N-S ! YDFSCALAR_EW(:) - List of grid-point scalar fields derivatives E-W ! YDFU_EW(:) - List of grid-point vector fields derivatives E-W (u) ! YDFV_EW(:) - List of grid-point vector fields derivatives E-W (v) USE YOMHOOK, ONLY : LHOOK, DR_HOOK, JPHOOK USE ECTRANS_FIELD_API_MOD, ONLY : FIELD_GRID, FIELD_SPEC, MAKE_FIELD_VIEW USE ECTRANS_FIELD_VIEW_MOD, ONLY: FIELD_VIEW USE PARKIND1, ONLY : JPIM, JPRB IMPLICIT NONE #include "fspgl_intf.h" INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: KRESOL TYPE(FIELD_SPEC),INTENT(IN), OPTIONAL :: YDFSPSCALAR(:) ! SPECTRAL SCALAR FIELDS (IN) TYPE(FIELD_SPEC),INTENT(IN), OPTIONAL :: YDFSPVOR(:), YDFSPDIV(:) ! SPECTRAL VECTOR FIELDS : VORTICITY AND DIVERGENCE FIELDS (IN) TYPE(FIELD_GRID),INTENT(INOUT), OPTIONAL :: YDFSCALAR(:) ! GRID SCALAR FIELDS (OUT) TYPE(FIELD_GRID),INTENT(INOUT), OPTIONAL :: YDFU(:),YDFV(:) ! GRID VECTOR FIELDS (OUT) TYPE(FIELD_GRID),INTENT(INOUT), OPTIONAL :: YDFVOR(:),YDFDIV(:) ! GRID VECTOR FIELDS :VORTICITY AND DIVERGENCE (OUT) TYPE(FIELD_GRID),INTENT(INOUT), OPTIONAL :: YDFSCALAR_NS(:), YDFSCALAR_EW(:) ! GRID SCALAR FIELDS DERIVATIVES EW AND NS (OUT) TYPE(FIELD_GRID),INTENT(INOUT), OPTIONAL :: YDFU_EW(:),YDFV_EW(:) ! GRID VECTOR FIELDS DERIVATIVES EW (OUT) PROCEDURE (FSPGL_INTF), POINTER, INTENT(IN), OPTIONAL :: FSPGL_PROC ! Local variables LOGICAL :: LLFSPGL_PROC ! List of FIELD_VIEW: intermediate representation of fields to facilitate copy to temporary arrays TYPE(FIELD_VIEW), ALLOCATABLE :: YLFVGU(:), YLFVGV(:) TYPE(FIELD_VIEW), ALLOCATABLE :: YLFVGVOR(:), YLFVGDIV(:) TYPE(FIELD_VIEW), ALLOCATABLE :: YLFVGU_EW(:), YLFVGV_EW(:) TYPE(FIELD_VIEW), ALLOCATABLE :: YLFVGSCALAR(:) TYPE(FIELD_VIEW), ALLOCATABLE :: YLFVGSCALAR_NS(:) TYPE(FIELD_VIEW), ALLOCATABLE :: YLFVGSCALAR_EW(:) TYPE(FIELD_VIEW), ALLOCATABLE :: YLFVSVOR(:), YLFVSDIV(:) TYPE(FIELD_VIEW), ALLOCATABLE :: YLFVSSCALAR(:) INTEGER(KIND=JPIM) :: IFIELD INTEGER(KIND=JPIM) :: NFIELD_UV, NFIELD_SCALAR INTEGER(KIND=JPIM) :: NFIELD_UVDER, NFIELD_DIVGP, NFIELD_SCDER, NFIELD_VORGP INTEGER(KIND=JPIM) :: IRESOL REAL(KIND=JPHOOK) :: ZHOOK_HANDLE #include "inv_trans_field_view.h" #include "abor1.intfb.h" ! We use ABOR1 and not ABORT_TRANS because ABORT_TRANS is to be private to trans routines, ! and this interface is conceptually outside trans. ! ------------------------------------------------------------------ IF (LHOOK) CALL DR_HOOK('INV_TRANS_FIELD_API',0,ZHOOK_HANDLE) ! ------------------------------------------------------------------------------------------------------------- ! Convert FIELD_API input fields into FIELD_VIEW, an intermediate representation of fields specific to ectrans IF (PRESENT(YDFU) .OR. PRESENT(YDFV) .OR. PRESENT(YDFSPVOR) .OR. PRESENT(YDFSPDIV)) THEN IF (.NOT. (PRESENT(YDFU) .AND. PRESENT(YDFV) .AND. PRESENT(YDFSPVOR) .AND. PRESENT(YDFSPDIV))) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFU, YDFV, YDFSPVOR AND YDFSPDIV MUST ALL BE PRESENT IF ANY IS PRESENT') ENDIF IF (SIZE(YDFU) /= SIZE(YDFV) .OR. SIZE(YDFU) /= SIZE(YDFSPVOR) .OR. SIZE(YDFU) /= SIZE(YDFSPDIV)) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFU, YDFV, YDFSPVOR AND YDFSPDIV MUST HAVE THE SAME SIZE') ENDIF ENDIF IF (PRESENT(YDFVOR)) THEN IF (.NOT. PRESENT(YDFSPVOR)) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFSPVOR BE PRESENT IF YDFVOR IS PRESENT') ENDIF IF (SIZE(YDFVOR) /= SIZE(YDFSPVOR)) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFVOR AND YDFSPVOR MUST HAVE THE SAME SIZE') ENDIF ENDIF IF (PRESENT(YDFDIV)) THEN IF (.NOT. PRESENT(YDFSPDIV)) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFSPDIV BE PRESENT IF YDFDIV IS PRESENT') ENDIF IF (SIZE(YDFDIV) /= SIZE(YDFSPDIV)) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFDIV AND YDFSPDIV MUST HAVE THE SAME SIZE') ENDIF ENDIF IF (PRESENT(YDFU_EW) .OR. PRESENT(YDFV_EW)) THEN IF (.NOT. (PRESENT(YDFU_EW) .AND. PRESENT(YDFV_EW))) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFU_EW AND YDFV_EW MUST BOTH BE PRESENT IF EITHER IS PRESENT') ENDIF IF (.NOT. PRESENT(YDFU)) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFU MUST BE PRESENT WITH YDFU_EW AND YDFV_EW') ENDIF IF (SIZE(YDFU_EW) /= SIZE(YDFV_EW) .OR. SIZE(YDFU_EW) /= SIZE(YDFU)) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFU_EW, YDFV_EW AND YDFU MUST HAVE THE SAME SIZE') ENDIF ENDIF IF (PRESENT(YDFSCALAR_NS) .OR. PRESENT(YDFSCALAR_EW)) THEN IF (.NOT. (PRESENT(YDFSCALAR_NS) .AND. PRESENT(YDFSCALAR_EW))) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFSCALAR_NS AND YDFSCALAR_EW MUST BOTH BE PRESENT IF EITHER IS PRESENT') ENDIF IF (.NOT. PRESENT(YDFSCALAR)) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFSCALAR MUST BE PRESENT WITH YDFSCALAR_NS AND YDFSCALAR_EW') ENDIF IF (SIZE(YDFSCALAR_NS) /= SIZE(YDFSCALAR_EW) .OR. SIZE(YDFSCALAR_NS) /= SIZE(YDFSCALAR)) THEN CALL ABOR1('INV_TRANS_FIELD_API: YDFSCALAR, YDFSCALAR_NS AND YDFSCALAR_EW MUST HAVE THE SAME SIZE') ENDIF ENDIF NFIELD_UV = 0 NFIELD_SCALAR = 0 NFIELD_UVDER = 0 NFIELD_DIVGP = 0 NFIELD_SCDER = 0 NFIELD_VORGP = 0 IF (PRESENT(YDFU)) THEN NFIELD_UV = SIZE(YDFU) ENDIF IF (PRESENT(YDFSCALAR)) THEN NFIELD_SCALAR = SIZE(YDFSCALAR) ENDIF IF (PRESENT(YDFU_EW) .AND. PRESENT(YDFV_EW)) THEN NFIELD_UVDER = NFIELD_UV ENDIF IF (PRESENT(YDFDIV)) THEN NFIELD_DIVGP = NFIELD_UV ENDIF IF (PRESENT(YDFVOR)) THEN NFIELD_VORGP = NFIELD_UV ENDIF IF (PRESENT(YDFSCALAR_NS) .AND. PRESENT(YDFSCALAR_EW)) THEN NFIELD_SCDER = NFIELD_SCALAR ENDIF ALLOCATE(YLFVSVOR(NFIELD_UV)) ALLOCATE(YLFVSDIV(NFIELD_UV)) ALLOCATE(YLFVSSCALAR(NFIELD_SCALAR)) ALLOCATE(YLFVGU(NFIELD_UV)) ALLOCATE(YLFVGV(NFIELD_UV)) ALLOCATE(YLFVGVOR(NFIELD_VORGP)) ALLOCATE(YLFVGDIV(NFIELD_DIVGP)) ALLOCATE(YLFVGSCALAR(NFIELD_SCALAR)) ALLOCATE(YLFVGU_EW(NFIELD_UVDER)) ALLOCATE(YLFVGV_EW(NFIELD_UVDER)) ALLOCATE(YLFVGSCALAR_NS(NFIELD_SCDER)) ALLOCATE(YLFVGSCALAR_EW(NFIELD_SCDER)) DO IFIELD=1,NFIELD_UV CALL MAKE_FIELD_VIEW(YLFVGU(IFIELD), YDFU(IFIELD), LDACC=.FALSE., LDRDONLY=.FALSE.) CALL MAKE_FIELD_VIEW(YLFVGV(IFIELD), YDFV(IFIELD), LDACC=.FALSE., LDRDONLY=.FALSE.) CALL MAKE_FIELD_VIEW(YLFVSVOR(IFIELD), YDFSPVOR(IFIELD), LDACC=.FALSE., LDRDONLY=.TRUE.) CALL MAKE_FIELD_VIEW(YLFVSDIV(IFIELD), YDFSPDIV(IFIELD), LDACC=.FALSE., LDRDONLY=.TRUE.) ENDDO DO IFIELD=1,NFIELD_UVDER CALL MAKE_FIELD_VIEW(YLFVGU_EW(IFIELD), YDFU_EW(IFIELD), LDACC=.FALSE., LDRDONLY=.FALSE.) CALL MAKE_FIELD_VIEW(YLFVGV_EW(IFIELD), YDFV_EW(IFIELD), LDACC=.FALSE., LDRDONLY=.FALSE.) ENDDO DO IFIELD=1,NFIELD_DIVGP CALL MAKE_FIELD_VIEW(YLFVGDIV(IFIELD), YDFDIV(IFIELD), LDACC=.FALSE., LDRDONLY=.FALSE.) ENDDO DO IFIELD=1,NFIELD_VORGP CALL MAKE_FIELD_VIEW(YLFVGVOR(IFIELD), YDFVOR(IFIELD), LDACC=.FALSE., LDRDONLY=.FALSE.) ENDDO DO IFIELD=1,NFIELD_SCALAR CALL MAKE_FIELD_VIEW(YLFVGSCALAR(IFIELD), YDFSCALAR(IFIELD), LDACC=.FALSE., LDRDONLY=.FALSE.) CALL MAKE_FIELD_VIEW(YLFVSSCALAR(IFIELD), YDFSPSCALAR(IFIELD), LDACC=.FALSE., LDRDONLY=.TRUE.) ENDDO DO IFIELD=1,NFIELD_SCDER CALL MAKE_FIELD_VIEW(YLFVGSCALAR_NS(IFIELD), YDFSCALAR_NS(IFIELD), LDACC=.FALSE., LDRDONLY=.FALSE.) CALL MAKE_FIELD_VIEW(YLFVGSCALAR_EW(IFIELD), YDFSCALAR_EW(IFIELD), LDACC=.FALSE., LDRDONLY=.FALSE.) ENDDO IRESOL = 1 IF (PRESENT(KRESOL)) THEN IRESOL = KRESOL ENDIF CALL INV_TRANS_FIELD_VIEW(IRESOL, & & YLFVSSCALAR, YLFVSVOR, YLFVSDIV, & & YLFVGSCALAR, YLFVGU, YLFVGV, & & YLFVGVOR, YLFVGDIV, & & YLFVGSCALAR_NS, YLFVGSCALAR_EW, YLFVGU_EW, YLFVGV_EW, & & FSPGL_PROC) DEALLOCATE(YLFVSVOR) DEALLOCATE(YLFVSDIV) DEALLOCATE(YLFVSSCALAR) DEALLOCATE(YLFVGU) DEALLOCATE(YLFVGV) DEALLOCATE(YLFVGSCALAR) DEALLOCATE(YLFVGVOR) DEALLOCATE(YLFVGDIV) DEALLOCATE(YLFVGU_EW) DEALLOCATE(YLFVGV_EW) DEALLOCATE(YLFVGSCALAR_NS) DEALLOCATE(YLFVGSCALAR_EW) IF (LHOOK) CALL DR_HOOK('INV_TRANS_FIELD_API',1,ZHOOK_HANDLE) ! ------------------------------------------------------------------ END SUBROUTINE INV_TRANS_FIELD_API