Skip to content

Commit

Permalink
Split FIELD_FACTOR into multiple files for faster compilation
Browse files Browse the repository at this point in the history
  • Loading branch information
awnawab committed Dec 3, 2023
1 parent 78777de commit 60f8631
Show file tree
Hide file tree
Showing 3 changed files with 145 additions and 119 deletions.
2 changes: 1 addition & 1 deletion CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,7 @@ list(APPEND srcs field_basic_module.F90 field_init_debug_value_module.F90 dev_al
foreach (SUFF IN ITEMS IM RM RB RD LM)
string (TOLOWER ${SUFF} suff)
foreach (RANK RANGE 2 5)
foreach (FUNC IN ITEMS "" _gathscat _access _util _array_util _buffer)
foreach (FUNC IN ITEMS "" _gathscat _access _util _array_util _buffer _factory)
if( NOT ((${FUNC} STREQUAL "_buffer") AND (${RANK} EQUAL 2)) )
add_custom_command (OUTPUT field_${RANK}${suff}${FUNC}_module.F90
COMMAND ${FYPP} -n -DRANK=${RANK} -DSUFF='${SUFF}' -m os -M ${CMAKE_CURRENT_SOURCE_DIR} -m fieldType
Expand Down
135 changes: 135 additions & 0 deletions field_RANKSUFF_factory_module.fypp
Original file line number Diff line number Diff line change
@@ -0,0 +1,135 @@
#! (C) Copyright 2022- ECMWF.
#! (C) Copyright 2022- 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.

MODULE FIELD_${RANK}$${SUFF}$_FACTORY_MODULE

#:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + str (SUFF)])

USE FIELD_MODULE
${fieldType.useParkind1 ()}$

IMPLICIT NONE

#include "abor1.intfb.h"

CONTAINS

#:for ft in fieldTypeList
SUBROUTINE ${ft.name}$_NEW_OWNER (FIELD_PTR, UBOUNDS, LBOUNDS, PERSISTENT, DELAYED, INIT_VALUE)

CLASS(${ft.name}$), POINTER :: FIELD_PTR
TYPE(${ft.name}$_OWNER), POINTER :: FIELD_OWNER
INTEGER(KIND=JPIM), INTENT(IN) :: UBOUNDS (${ft.rank}$)
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: LBOUNDS (${ft.rank}$)
LOGICAL, OPTIONAL, INTENT(IN) :: PERSISTENT
LOGICAL, OPTIONAL, INTENT(IN) :: DELAYED
${ft.type}$, OPTIONAL, INTENT(IN) :: INIT_VALUE

ALLOCATE (FIELD_OWNER)

CALL FIELD_OWNER%INIT (LBOUNDS=LBOUNDS, UBOUNDS=UBOUNDS, PERSISTENT=PERSISTENT, DELAYED=DELAYED, INIT_VALUE=INIT_VALUE)

FIELD_PTR => FIELD_OWNER

END SUBROUTINE

SUBROUTINE ${ft.name}$_NEW_WRAPPER (FIELD_PTR, LBOUNDS, PERSISTENT, DATA)

CLASS(${ft.name}$), POINTER :: FIELD_PTR
${ft.type}$, TARGET, INTENT (IN) :: DATA (${ft.shape}$)
TYPE(${ft.name}$_WRAPPER), POINTER :: FIELD_WRAPPER
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: LBOUNDS (${ft.rank}$)
LOGICAL, OPTIONAL, INTENT(IN) :: PERSISTENT

ALLOCATE (FIELD_WRAPPER)

CALL FIELD_WRAPPER%INIT (DATA, LBOUNDS=LBOUNDS, PERSISTENT=PERSISTENT)

FIELD_PTR => FIELD_WRAPPER

END SUBROUTINE

#:if ft.rank > 2
SUBROUTINE ${ft.name}$_DELETE (FIELD_PTR, CHILDREN)
CLASS(${ft.name}$), POINTER :: FIELD_PTR
TYPE(${f'FIELD_{ft.rank-1}{ft.suffix}'}$_PTR), ALLOCATABLE, OPTIONAL :: CHILDREN(:)
#:else
SUBROUTINE ${ft.name}$_DELETE (FIELD_PTR)
CLASS(${ft.name}$), POINTER :: FIELD_PTR
#:endif

CALL FIELD_PTR%FINAL ()
DEALLOCATE (FIELD_PTR)
NULLIFY (FIELD_PTR)

#:if ft.rank > 2
IF(PRESENT(CHILDREN))THEN
DEALLOCATE(CHILDREN)
ELSE
SELECT TYPE(FIELD_PTR)
TYPE IS (${ft.name}$_BUFFER_OWNER)
CALL ABOR1("${ft.name}$_DELETE: CHILDREN FIELDS MUST ALSO BE DELETED")
TYPE IS (${ft.name}$_BUFFER_WRAPPER)
CALL ABOR1("${ft.name}$_DELETE: CHILDREN FIELDS MUST ALSO BE DELETED")
END SELECT
ENDIF
#:endif

END SUBROUTINE

#:if ft.rank > 2
SUBROUTINE ${ft.name}$_NEW_BUFFER_WRAPPER (FIELD_PTR, NUM_CHILDREN, CHILDREN, LBOUNDS, DATA, PERSISTENT, CONTIG_FIELDS)

CLASS(${ft.name}$), POINTER, INTENT(OUT) :: FIELD_PTR
INTEGER(KIND=JPIM), INTENT(IN) :: NUM_CHILDREN
TYPE(${f'FIELD_{ft.rank-1}{ft.suffix}'}$_PTR), ALLOCATABLE, INTENT(OUT) :: CHILDREN(:)

${ft.type}$, OPTIONAL, TARGET, INTENT (IN) :: DATA (${ft.shape}$)
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: LBOUNDS (${ft.rank}$)
LOGICAL, OPTIONAL, INTENT(IN) :: PERSISTENT
LOGICAL, OPTIONAL, INTENT(IN) :: CONTIG_FIELDS

TYPE(${ft.name}$_BUFFER_WRAPPER), POINTER :: FIELD_BUFFER

ALLOCATE(FIELD_BUFFER)
ALLOCATE(CHILDREN(NUM_CHILDREN))
CALL FIELD_BUFFER%BUFFER_INIT(NUM_CHILDREN, CHILDREN, LBOUNDS=LBOUNDS, DATA=DATA, PERSISTENT=PERSISTENT, &
& CONTIG_FIELDS=CONTIG_FIELDS)

FIELD_PTR => FIELD_BUFFER

END SUBROUTINE ${ft.name}$_NEW_BUFFER_WRAPPER

SUBROUTINE ${ft.name}$_NEW_BUFFER_OWNER (FIELD_PTR, NUM_CHILDREN, CHILDREN, LBOUNDS, UBOUNDS, PERSISTENT, CONTIG_FIELDS, INIT_VALUE)

CLASS(${ft.name}$), POINTER, INTENT(OUT) :: FIELD_PTR
INTEGER(KIND=JPIM), INTENT(IN) :: NUM_CHILDREN
TYPE(${f'FIELD_{ft.rank-1}{ft.suffix}'}$_PTR), ALLOCATABLE, INTENT(OUT) :: CHILDREN(:)

INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: LBOUNDS (${ft.rank}$)
INTEGER(KIND=JPIM), INTENT(IN) :: UBOUNDS (${ft.rank}$)
LOGICAL, OPTIONAL, INTENT(IN) :: PERSISTENT
LOGICAL, OPTIONAL, INTENT(IN) :: CONTIG_FIELDS
${ft.type}$, OPTIONAL, INTENT(IN) :: INIT_VALUE

TYPE(${ft.name}$_BUFFER_OWNER), POINTER :: FIELD_BUFFER

ALLOCATE(FIELD_BUFFER)
ALLOCATE(CHILDREN(NUM_CHILDREN))
CALL FIELD_BUFFER%BUFFER_INIT(NUM_CHILDREN, CHILDREN, LBOUNDS=LBOUNDS, UBOUNDS=UBOUNDS, PERSISTENT=PERSISTENT, &
& CONTIG_FIELDS=CONTIG_FIELDS, INIT_VALUE=INIT_VALUE)

FIELD_PTR => FIELD_BUFFER

END SUBROUTINE ${ft.name}$_NEW_BUFFER_OWNER
#:endif

#:endfor

END MODULE FIELD_${RANK}$${SUFF}$_FACTORY_MODULE
127 changes: 9 additions & 118 deletions field_factory_module.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -11,22 +11,21 @@ MODULE FIELD_FACTORY_MODULE

#:set fieldTypeList = fieldType.getFieldTypeList ()

USE FIELD_MODULE
${fieldType.useParkind1 ()}$
#:for ft in fieldTypeList
USE ${ft.name}$_FACTORY_MODULE
#:endfor

IMPLICIT NONE

PRIVATE

#include "abor1.intfb.h"

INTERFACE FIELD_NEW
#:for ft in fieldTypeList
MODULE PROCEDURE ${ft.name}$_NEW_OWNER
MODULE PROCEDURE ${ft.name}$_NEW_WRAPPER
PROCEDURE ${ft.name}$_NEW_OWNER
PROCEDURE ${ft.name}$_NEW_WRAPPER
#:if ft.rank > 2
MODULE PROCEDURE ${ft.name}$_NEW_BUFFER_WRAPPER
MODULE PROCEDURE ${ft.name}$_NEW_BUFFER_OWNER
PROCEDURE ${ft.name}$_NEW_BUFFER_WRAPPER
PROCEDURE ${ft.name}$_NEW_BUFFER_OWNER
#:endif
#:endfor
END INTERFACE
Expand All @@ -35,7 +34,7 @@ PUBLIC :: FIELD_NEW

INTERFACE FIELD_DELETE
#:for ft in fieldTypeList
MODULE PROCEDURE ${ft.name}$_DELETE
PROCEDURE ${ft.name}$_DELETE
#:endfor
END INTERFACE FIELD_DELETE

Expand All @@ -52,114 +51,6 @@ PUBLIC :: FIELD_RESIZE
CONTAINS

#:for ft in fieldTypeList
SUBROUTINE ${ft.name}$_NEW_OWNER (FIELD_PTR, UBOUNDS, LBOUNDS, PERSISTENT, DELAYED, INIT_VALUE)

CLASS(${ft.name}$), POINTER :: FIELD_PTR
TYPE(${ft.name}$_OWNER), POINTER :: FIELD_OWNER
INTEGER(KIND=JPIM), INTENT(IN) :: UBOUNDS (${ft.rank}$)
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: LBOUNDS (${ft.rank}$)
LOGICAL, OPTIONAL, INTENT(IN) :: PERSISTENT
LOGICAL, OPTIONAL, INTENT(IN) :: DELAYED
${ft.type}$, OPTIONAL, INTENT(IN) :: INIT_VALUE

ALLOCATE (FIELD_OWNER)

CALL FIELD_OWNER%INIT (LBOUNDS=LBOUNDS, UBOUNDS=UBOUNDS, PERSISTENT=PERSISTENT, DELAYED=DELAYED, INIT_VALUE=INIT_VALUE)

FIELD_PTR => FIELD_OWNER

END SUBROUTINE

SUBROUTINE ${ft.name}$_NEW_WRAPPER (FIELD_PTR, LBOUNDS, PERSISTENT, DATA)

CLASS(${ft.name}$), POINTER :: FIELD_PTR
${ft.type}$, TARGET, INTENT (IN) :: DATA (${ft.shape}$)
TYPE(${ft.name}$_WRAPPER), POINTER :: FIELD_WRAPPER
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: LBOUNDS (${ft.rank}$)
LOGICAL, OPTIONAL, INTENT(IN) :: PERSISTENT

ALLOCATE (FIELD_WRAPPER)

CALL FIELD_WRAPPER%INIT (DATA, LBOUNDS=LBOUNDS, PERSISTENT=PERSISTENT)

FIELD_PTR => FIELD_WRAPPER

END SUBROUTINE

#:if ft.rank > 2
SUBROUTINE ${ft.name}$_DELETE (FIELD_PTR, CHILDREN)
CLASS(${ft.name}$), POINTER :: FIELD_PTR
TYPE(${f'FIELD_{ft.rank-1}{ft.suffix}'}$_PTR), ALLOCATABLE, OPTIONAL :: CHILDREN(:)
#:else
SUBROUTINE ${ft.name}$_DELETE (FIELD_PTR)
CLASS(${ft.name}$), POINTER :: FIELD_PTR
#:endif

CALL FIELD_PTR%FINAL ()
DEALLOCATE (FIELD_PTR)
NULLIFY (FIELD_PTR)

#:if ft.rank > 2
IF(PRESENT(CHILDREN))THEN
DEALLOCATE(CHILDREN)
ELSE
SELECT TYPE(FIELD_PTR)
TYPE IS (${ft.name}$_BUFFER_OWNER)
CALL ABOR1("${ft.name}$_DELETE: CHILDREN FIELDS MUST ALSO BE DELETED")
TYPE IS (${ft.name}$_BUFFER_WRAPPER)
CALL ABOR1("${ft.name}$_DELETE: CHILDREN FIELDS MUST ALSO BE DELETED")
END SELECT
ENDIF
#:endif

END SUBROUTINE

#:if ft.rank > 2
SUBROUTINE ${ft.name}$_NEW_BUFFER_WRAPPER (FIELD_PTR, NUM_CHILDREN, CHILDREN, LBOUNDS, DATA, PERSISTENT, CONTIG_FIELDS)

CLASS(${ft.name}$), POINTER, INTENT(OUT) :: FIELD_PTR
INTEGER(KIND=JPIM), INTENT(IN) :: NUM_CHILDREN
TYPE(${f'FIELD_{ft.rank-1}{ft.suffix}'}$_PTR), ALLOCATABLE, INTENT(OUT) :: CHILDREN(:)

${ft.type}$, OPTIONAL, TARGET, INTENT (IN) :: DATA (${ft.shape}$)
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: LBOUNDS (${ft.rank}$)
LOGICAL, OPTIONAL, INTENT(IN) :: PERSISTENT
LOGICAL, OPTIONAL, INTENT(IN) :: CONTIG_FIELDS

TYPE(${ft.name}$_BUFFER_WRAPPER), POINTER :: FIELD_BUFFER

ALLOCATE(FIELD_BUFFER)
ALLOCATE(CHILDREN(NUM_CHILDREN))
CALL FIELD_BUFFER%BUFFER_INIT(NUM_CHILDREN, CHILDREN, LBOUNDS=LBOUNDS, DATA=DATA, PERSISTENT=PERSISTENT, &
& CONTIG_FIELDS=CONTIG_FIELDS)

FIELD_PTR => FIELD_BUFFER

END SUBROUTINE ${ft.name}$_NEW_BUFFER_WRAPPER

SUBROUTINE ${ft.name}$_NEW_BUFFER_OWNER (FIELD_PTR, NUM_CHILDREN, CHILDREN, LBOUNDS, UBOUNDS, PERSISTENT, CONTIG_FIELDS)

CLASS(${ft.name}$), POINTER, INTENT(OUT) :: FIELD_PTR
INTEGER(KIND=JPIM), INTENT(IN) :: NUM_CHILDREN
TYPE(${f'FIELD_{ft.rank-1}{ft.suffix}'}$_PTR), ALLOCATABLE, INTENT(OUT) :: CHILDREN(:)

INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: LBOUNDS (${ft.rank}$)
INTEGER(KIND=JPIM), INTENT(IN) :: UBOUNDS (${ft.rank}$)
LOGICAL, OPTIONAL, INTENT(IN) :: PERSISTENT
LOGICAL, OPTIONAL, INTENT(IN) :: CONTIG_FIELDS

TYPE(${ft.name}$_BUFFER_OWNER), POINTER :: FIELD_BUFFER

ALLOCATE(FIELD_BUFFER)
ALLOCATE(CHILDREN(NUM_CHILDREN))
CALL FIELD_BUFFER%BUFFER_INIT(NUM_CHILDREN, CHILDREN, LBOUNDS=LBOUNDS, UBOUNDS=UBOUNDS, PERSISTENT=PERSISTENT, &
& CONTIG_FIELDS=CONTIG_FIELDS)

FIELD_PTR => FIELD_BUFFER

END SUBROUTINE ${ft.name}$_NEW_BUFFER_OWNER
#:endif

SUBROUTINE ${ft.name}$_RESIZE (FIELD_PTR, UBOUNDS, LBOUNDS, PERSISTENT)

CLASS(${ft.name}$), POINTER :: FIELD_PTR
Expand All @@ -176,4 +67,4 @@ END SUBROUTINE ${ft.name}$_RESIZE

#:endfor

END MODULE
END MODULE FIELD_FACTORY_MODULE

0 comments on commit 60f8631

Please sign in to comment.