"Fossies" - the Fresh Open Source Software Archive

Member "fimex-1.4.1/modules/F90/fimex2d.F90" (30 Oct 2019, 25432 Bytes) of package /linux/privat/fimex-1.4.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Fortran 90 source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. For more information about "fimex2d.F90" see the Fossies "Dox" file reference documentation.

    1 !> @file
    2 !! Fimex F90 interface for 2-dimensional fields
    3 
    4 !> @brief Fimex Fortran90 interface for 2-dimensional fields
    5 !! @author Trygve Aspelien, Heiko Klein
    6 !!
    7 !! The Fimex F90 interface for 2-dimensional fields contains support routines
    8 !! for typical handling of 2-dimensional meteorological fields.
    9 !!
   10 !! The fimex.f90 interface is currently not precompiled with building fimex. Please
   11 !! copy the fimex.f90 file to your f90-project and compile it from there, and link with ''-lfimex2d''.
   12 !!
   13 !! @see https://github.com/metno/fimex/blob/master/modules/F90/fimex2d.F90
   14 
   15 MODULE FIMEX2D
   16   INTEGER,PARAMETER              :: RKIND=8
   17   INTEGER,PARAMETER              :: IKIND=4
   18   REAL(KIND=RKIND),PARAMETER     :: XUNDEF=1e20
   19 
   20   INTERFACE
   21     !> Read all dimension values from a dimension
   22     !! @param FIO the fimex-object
   23     !! @param DIMSIZE the size of the dimension to read
   24     !! @param DIMNAME the name of the dimension to read
   25     !! @param CUNIT optional unit (e.g. reading time)
   26     !!
   27     SUBROUTINE FI_READ_DIMENSION(FIO,DIMSIZE,DIMNAME,DIMVALUES,CUNIT)
   28       USE FIMEX     ,ONLY : FimexIO
   29       IMPORT                                                 :: RKIND,IKIND
   30       IMPLICIT NONE
   31       TYPE(FimexIO),                 INTENT(INOUT)           :: FIO
   32       INTEGER,                       INTENT(IN)              :: DIMSIZE
   33       CHARACTER(LEN=*),              INTENT(IN)              :: DIMNAME
   34       REAL(KIND=RKIND),DIMENSION(:), INTENT(OUT)             :: DIMVALUES
   35       CHARACTER(LEN=*),              INTENT(IN),OPTIONAL     :: CUNIT
   36     END SUBROUTINE
   37 
   38     !> Get dimensions of a variable
   39     !! @param FIO the fimex-object
   40     !! @param VARNAME the varible to check dimensions for
   41     !! @param NX optional The x dimension
   42     !! @param NY optional The y dimension
   43     !! @param NZ optional The z dimension
   44     !! @param NREL optional The realization dimension (ensemble size)
   45     !! @param NTIMES optional The time dimension
   46     !! @param X_GEO optional If x is geographical coordinate
   47     !! @param Y_GEO optional If y is geographical coordinate
   48     !! @param DIMNAME_X optional Name of x dimension
   49     !! @param DIMNAME_Y optional Name of y dimension
   50     !! @param DIMNAME_Z optional Name of z dimension
   51     !! @param DIMNAME_T optional Name of t dimension
   52     !! @param DIMNAME_R optional Name of realization dimension
   53     !! @param BASETIME optional Epoch time in seconds for first step in file
   54     !! @param VERBOSITY optional Set the verbosity level to print
   55     !!
   56     SUBROUTINE FI_GET_DIMENSIONS(FIO,VARNAME,NX,NY,NZ,NREL,NTIMES,X_GEO,Y_GEO,&
   57                                DIMNAME_X,DIMNAME_Y,DIMNAME_Z,DIMNAME_T,DIMNAME_R,BASETIME,VERBOSITY)
   58       USE FIMEX     ,ONLY : FimexIO,AXIS_GeoX,AXIS_Lon,AXIS_GeoY,AXIS_Lat,AXIS_GeoZ,AXIS_Time,&
   59                                 AXIS_Pressure,AXIS_Height,AXIS_realization
   60       IMPORT                                             :: RKIND,IKIND
   61       IMPLICIT NONE
   62       TYPE(FimexIO),             INTENT(INOUT)           :: FIO
   63       CHARACTER(LEN=*),          INTENT(IN)              :: VARNAME
   64       INTEGER(KIND=IKIND),       INTENT(OUT),  OPTIONAL  :: NX
   65       INTEGER(KIND=IKIND),       INTENT(OUT),  OPTIONAL  :: NY
   66       INTEGER(KIND=IKIND),       INTENT(OUT),  OPTIONAL  :: NZ
   67       INTEGER(KIND=IKIND),       INTENT(OUT),  OPTIONAL  :: NREL
   68       INTEGER(KIND=IKIND),       INTENT(OUT),  OPTIONAL  :: NTIMES
   69       LOGICAL,                   INTENT(OUT),  OPTIONAL  :: X_GEO
   70       LOGICAL,                   INTENT(OUT),  OPTIONAL  :: Y_GEO
   71       CHARACTER(LEN=*),          INTENT(OUT),  OPTIONAL  :: DIMNAME_X
   72       CHARACTER(LEN=*),          INTENT(OUT),  OPTIONAL  :: DIMNAME_Y
   73       CHARACTER(LEN=*),          INTENT(OUT),  OPTIONAL  :: DIMNAME_Z
   74       CHARACTER(LEN=*),          INTENT(OUT),  OPTIONAL  :: DIMNAME_T
   75       CHARACTER(LEN=*),          INTENT(OUT),  OPTIONAL  :: DIMNAME_R
   76       REAL(KIND=RKIND),          INTENT(OUT),  OPTIONAL  :: BASETIME
   77       INTEGER(KIND=IKIND),       INTENT(IN),   OPTIONAL  :: VERBOSITY
   78     END SUBROUTINE
   79 
   80     !> Read a 2-dimensional x,y field for any other given dimension(s)
   81     !! @param FIO the fimex-object
   82     !! @param VARNAME The variable to be read
   83     !! @param NX The x dimension size
   84     !! @param NY The y dimension size
   85     !! @param FIELD The field to be read in
   86     !! @param STEP optional step for time dimension
   87     !! @param REL optional realization for realization dimension (EPS)
   88     !! @param LEVEL optional vertical level
   89     !! @param TIME optional Epoch time in seconds for time step
   90     !! @param BASETIME optional Epoch time in seconds for first step in file
   91     !! @param CUNIT optional unit Udunit2 compatible unit
   92     !! @param LCONT_ON_ERROR optional Option to tolerate errors
   93     !! @param VERBOSITY optional Set the verbosity level to print
   94     !!
   95     SUBROUTINE FI_READ_FIELD(FIO,VARNAME,NX,NY,FIELD,STEP,REL,LEVEL,TIME,BASETIME,CUNIT,LCONT_ON_ERROR,VERBOSITY)
   96       USE FIMEX     ,ONLY : FimexIO
   97       IMPORT                                                   :: RKIND,IKIND
   98       IMPLICIT NONE
   99       TYPE(FimexIO),                     INTENT(INOUT)           :: FIO
  100       CHARACTER(LEN=*),                  INTENT(IN)              :: VARNAME
  101       INTEGER(KIND=IKIND),               INTENT(IN)              :: NX
  102       INTEGER(KIND=IKIND),               INTENT(IN)              :: NY
  103       REAL(KIND=RKIND),DIMENSION(NX,NY), INTENT(OUT)             :: FIELD
  104       INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: STEP
  105       INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: REL
  106       INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: LEVEL
  107       REAL(KIND=RKIND),                  INTENT(OUT),  OPTIONAL  :: TIME
  108       REAL(KIND=RKIND),                  INTENT(OUT),  OPTIONAL  :: BASETIME
  109       CHARACTER(LEN=*),                  INTENT(IN),   OPTIONAL  :: CUNIT
  110       LOGICAL,                           INTENT(INOUT),OPTIONAL  :: LCONT_ON_ERROR
  111       INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: VERBOSITY
  112     END SUBROUTINE
  113 
  114     !> Write a 2-dimensional x,y field for any other given dimension(s). The file must be pre-generated with the proper dimensions
  115     !! @param FIO the fimex-object
  116     !! @param VARNAME Variable name
  117     !! @param NX The x dimension
  118     !! @param NY The y dimension
  119     !! @param OUTFIELD The 2-dimensional output field
  120     !! @param STEP optional Step for time dimension
  121     !! @param REL optional Realization for realization dimension (EPS)
  122     !! @param LEVEL optional Vertical level
  123     !! @param TIME optional Epoch time in seconds
  124     !! @param CUNIT optional unit Udunit2 compatible unit
  125     !! @param VERBOSITY optional Set the verbosity level to print
  126     !!
  127     SUBROUTINE FI_WRITE_FIELD(FIO,VARNAME,NX,NY,OUTFIELD,STEP,REL,LEVEL,CUNIT,VERBOSITY)
  128       USE FIMEX, ONLY                                             : FimexIO
  129       IMPORT                                                     :: RKIND,IKIND
  130       IMPLICIT NONE
  131       TYPE(FimexIO),                     INTENT(INOUT)           :: FIO
  132       CHARACTER(len=*),                  INTENT(IN)              :: VARNAME
  133       INTEGER(KIND=IKIND),               INTENT(IN)              :: NX
  134       INTEGER(KIND=IKIND),               INTENT(IN)              :: NY
  135       REAL(KIND=RKIND),DIMENSION(NX*NY), INTENT(IN)              :: OUTFIELD
  136       INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: STEP
  137       INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: REL
  138       INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: LEVEL
  139       CHARACTER(LEN=*),                  INTENT(IN),   OPTIONAL  :: CUNIT
  140       INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: VERBOSITY
  141     END SUBROUTINE
  142 
  143     !> Convert an epoch time to a DTG (YYYYMMDDHH)
  144     !! @param EPOCH time in seconds since January 1st 1970
  145     !!
  146     FUNCTION EPOCH2DTG(EPOCH)
  147       IMPORT                       :: RKIND,IKIND
  148       IMPLICIT NONE
  149       INTEGER(KIND=IKIND)          :: EPOCH2DTG
  150       REAL(KIND=RKIND), INTENT(IN) :: EPOCH
  151     END FUNCTION
  152 
  153     !> Print an error string and abort
  154     !! @param ERROR_STRING The string to be printed
  155     !!
  156     SUBROUTINE FI_ERROR(ERROR_STRING)
  157       IMPLICIT NONE
  158       CHARACTER(*),INTENT(IN) :: ERROR_STRING
  159     END SUBROUTINE
  160   END INTERFACE
  161 END MODULE
  162 
  163 FUNCTION EPOCH2DTG(EPOCH)
  164   USE FIMEX2D    ,ONLY : RKIND,IKIND
  165 #ifdef __INTELCOMP
  166   USE IFPORT
  167 #endif
  168   IMPLICIT NONE
  169   INTEGER(KIND=IKIND)              :: EPOCH2DTG
  170   REAL(KIND=RKIND), INTENT(IN)     :: EPOCH
  171   CHARACTER(LEN=10)                :: STRING
  172   INTEGER(KIND=IKIND),DIMENSION(9) :: GMT
  173 
  174   CALL GMTIME(INT(EPOCH),GMT)
  175   WRITE(STRING(1:4),'(I4.4)') GMT(6)+1900
  176   WRITE(STRING(5:6),'(I2.2)') GMT(5)+1
  177   WRITE(STRING(7:8),'(I2.2)') GMT(4)
  178   WRITE(STRING(9:10),'(I2.2)') (GMT(3)*3600+GMT(2)*60+GMT(1))/3600
  179   READ(STRING(1:10),'(I10.10)') EPOCH2DTG
  180 END FUNCTION
  181 
  182 SUBROUTINE FI_ERROR(ERROR_STRING)
  183   IMPLICIT NONE
  184   CHARACTER(*),INTENT(IN) :: ERROR_STRING
  185 
  186   WRITE(*,*) '******** ERROR ***********'
  187   WRITE(*,*) ERROR_STRING
  188   WRITE(*,*) '**************************'
  189 
  190   CALL ABORT()
  191 END SUBROUTINE FI_ERROR
  192 
  193 
  194 SUBROUTINE FI_READ_DIMENSION(FIO,DIMSIZE,DIMNAME,DIMVALUES,CUNIT)
  195   USE FIMEX     ,ONLY : FimexIO
  196   USE FIMEX2D    ,ONLY : RKIND,IKIND
  197   TYPE(FimexIO),                 INTENT(INOUT)           :: FIO
  198   INTEGER,                       INTENT(IN)              :: DIMSIZE
  199   CHARACTER(LEN=*),              INTENT(IN)              :: DIMNAME
  200   REAL(KIND=RKIND),DIMENSION(:), INTENT(OUT)             :: DIMVALUES
  201   CHARACTER(LEN=*),              INTENT(IN),OPTIONAL     :: CUNIT
  202   REAL(KIND=RKIND),DIMENSION(:),ALLOCATABLE              :: ZDIMVALUES
  203 
  204    ! Create slice builder for time variable
  205    NDIMS=FIO%GET_DIMENSIONS(TRIM(DIMNAME))
  206    IF ( NDIMS <= 0 ) CALL FI_ERROR("Can't get dimensions for variable "//TRIM(DIMNAME))
  207 
  208    IF ( .NOT.ALLOCATED(ZDIMVALUES)) ALLOCATE(ZDIMVALUES(DIMSIZE))
  209    IF(PRESENT(CUNIT)) THEN
  210      IERR=FIO%READ(TRIM(DIMNAME),ZDIMVALUES,CUNIT)
  211    ELSE
  212      IERR=FIO%READ(TRIM(DIMNAME),ZDIMVALUES)
  213    ENDIF
  214    DIMVALUES=ZDIMVALUES
  215 
  216 END SUBROUTINE FI_READ_DIMENSION
  217 
  218 SUBROUTINE FI_GET_DIMENSIONS(FIO,VARNAME,NX,NY,NZ,NREL,NTIMES,&
  219                              X_GEO,Y_GEO,&
  220                              DIMNAME_X,DIMNAME_Y,DIMNAME_Z,DIMNAME_T,DIMNAME_R,&
  221                              BASETIME,VERBOSITY)
  222   USE FIMEX     ,ONLY : FimexIO,AXIS_GeoX,AXIS_Lon,&
  223                                 AXIS_GeoY,AXIS_Lat,&
  224                                 AXIS_GeoZ,AXIS_Pressure,AXIS_Height,&
  225                                 AXIS_Time,&
  226                                 AXIS_realization
  227   USE FIMEX2D    ,ONLY : RKIND,IKIND
  228   IMPLICIT NONE
  229   TYPE(FimexIO),             INTENT(INOUT)           :: FIO
  230   CHARACTER(LEN=*),          INTENT(IN)              :: VARNAME
  231   INTEGER(KIND=IKIND),       INTENT(OUT),  OPTIONAL  :: NX
  232   INTEGER(KIND=IKIND),       INTENT(OUT),  OPTIONAL  :: NY
  233   INTEGER(KIND=IKIND),       INTENT(OUT),  OPTIONAL  :: NZ
  234   INTEGER(KIND=IKIND),       INTENT(OUT),  OPTIONAL  :: NREL
  235   INTEGER(KIND=IKIND),       INTENT(OUT),  OPTIONAL  :: NTIMES
  236   LOGICAL,                   INTENT(OUT),  OPTIONAL  :: X_GEO
  237   LOGICAL,                   INTENT(OUT),  OPTIONAL  :: Y_GEO
  238   CHARACTER(LEN=*),          INTENT(OUT),  OPTIONAL  :: DIMNAME_T
  239   CHARACTER(LEN=*),          INTENT(OUT),  OPTIONAL  :: DIMNAME_X
  240   CHARACTER(LEN=*),          INTENT(OUT),  OPTIONAL  :: DIMNAME_Y
  241   CHARACTER(LEN=*),          INTENT(OUT),  OPTIONAL  :: DIMNAME_Z
  242   CHARACTER(LEN=*),          INTENT(OUT),  OPTIONAL  :: DIMNAME_R
  243   REAL(KIND=RKIND),          INTENT(OUT),  OPTIONAL  :: BASETIME
  244   INTEGER(KIND=IKIND),       INTENT(IN),   OPTIONAL  :: VERBOSITY
  245   CHARACTER(LEN=1024)                                :: DIMNAME_BT
  246   INTEGER(KIND=IKIND), ALLOCATABLE, DIMENSION(:)     :: START,VSIZE,ATYPES
  247   INTEGER(KIND=IKIND)                                :: I,NDIMS,IERR,VERB
  248   REAL(KIND=RKIND),DIMENSION(:),ALLOCATABLE,TARGET   :: ZBASETIME
  249 
  250   IF (PRESENT(DIMNAME_X)) DIMNAME_X="NA"
  251   IF (PRESENT(DIMNAME_Y)) DIMNAME_Y="NA"
  252   IF (PRESENT(DIMNAME_Z)) DIMNAME_Z="NA"
  253   IF (PRESENT(DIMNAME_T)) DIMNAME_T="NA"
  254   IF (PRESENT(DIMNAME_R)) DIMNAME_R="NA"
  255   IF (PRESENT(BASETIME)) DIMNAME_BT="NA"
  256   VERB=0
  257   IF ( PRESENT(VERBOSITY)) VERB=VERBOSITY
  258 
  259   IF ( VERB > 0 ) WRITE(*,*) 'Getting dimensions for '//TRIM(VARNAME)
  260   NDIMS=FIO%GET_DIMENSIONS(TRIM(VARNAME))
  261   IF ( NDIMS <= 0 ) THEN
  262     CALL FI_ERROR("Can't make slicebuilder when getting dimensions for variable "//TRIM(VARNAME))
  263   ENDIF
  264   ALLOCATE(START(NDIMS))
  265   ALLOCATE(VSIZE(NDIMS))
  266   IERR = FIO%GET_DIMENSION_START_SIZE(START, VSIZE)
  267   IF ( IERR /= 0 ) CALL FI_ERROR("Can't get start and size for variable "//TRIM(VARNAME))
  268   ALLOCATE(ATYPES(NDIMS))
  269   IERR = FIO%GET_AXISTYPES(ATYPES)
  270   IF ( IERR /= 0 ) CALL FI_ERROR("Can't get axistypes for variable "//TRIM(VARNAME))
  271 
  272   DO I = 1, NDIMS
  273     IF ( VERB > 2 ) write(*,*) trim(FIO%GET_DIMNAME(I)),ATYPES(I)
  274     SELECT CASE (ATYPES(I))
  275       CASE(AXIS_GeoX, AXIS_Lon)
  276         IF (PRESENT(NX)) NX = VSIZE(I)
  277         IF (PRESENT(DIMNAME_X)) DIMNAME_X=FIO%GET_DIMNAME(I)
  278         SELECT CASE (ATYPES(I))
  279           CASE(AXIS_Lon)
  280             IF (PRESENT(X_GEO)) X_GEO=.FALSE.
  281           CASE DEFAULT
  282             IF (PRESENT(DIMNAME_X)) DIMNAME_X=FIO%GET_VAR_LONGITUDE(VARNAME)
  283             IF (PRESENT(X_GEO)) X_GEO=.TRUE.
  284         END SELECT
  285       CASE(AXIS_GeoY, AXIS_Lat)
  286         IF (PRESENT(NY)) NY = VSIZE(I)
  287         IF (PRESENT(DIMNAME_Y)) DIMNAME_Y=FIO%GET_DIMNAME(I)
  288         SELECT CASE (ATYPES(I))
  289           CASE(AXIS_Lat)
  290             IF (PRESENT(Y_GEO)) Y_GEO=.FALSE.
  291           CASE DEFAULT
  292             IF (PRESENT(DIMNAME_Y)) DIMNAME_Y=FIO%GET_VAR_LATITUDE(VARNAME)
  293             IF (PRESENT(Y_GEO)) Y_GEO=.TRUE.
  294         END SELECT
  295       CASE(AXIS_GeoZ,AXIS_Pressure,AXIS_Height)
  296         IF (PRESENT(NZ)) NZ=VSIZE(I)
  297         IF (PRESENT(DIMNAME_Z)) DIMNAME_Z=FIO%GET_DIMNAME(I)
  298       CASE(AXIS_Realization)
  299         IF (PRESENT(NREL)) NREL=VSIZE(I)
  300         IF (PRESENT(DIMNAME_R)) DIMNAME_R=FIO%GET_DIMNAME(I)
  301       CASE(AXIS_Time)
  302         IF (PRESENT(NTIMES)) NTIMES=VSIZE(I)
  303         IF (PRESENT(DIMNAME_T)) DIMNAME_T=FIO%GET_DIMNAME(I)
  304         IF (PRESENT(BASETIME)) DIMNAME_BT=FIO%GET_DIMNAME(I)
  305       CASE DEFAULT
  306         WRITE(*,*) "WARNING: Dimension "//TRIM(FIO%GET_DIMNAME(I))//" is not recognised! Dimension size: ",VSIZE(I)
  307     END SELECT
  308   END DO
  309   DEALLOCATE(START)
  310   DEALLOCATE(VSIZE)
  311   DEALLOCATE(ATYPES)
  312 
  313   ! Find basetime in file
  314   IF (PRESENT(BASETIME)) THEN
  315     IF (TRIM(DIMNAME_BT) /= "NA") THEN
  316       NDIMS=FIO%GET_DIMENSIONS(TRIM(DIMNAME_BT))
  317       IF ( NDIMS <= 0 ) CALL FI_ERROR("Can't get dimensions for variable "//TRIM(DIMNAME_BT))
  318       IERR=FIO%REDUCE_DIMENSION(DIMNAME_BT,0,1)
  319       IF ( IERR /= 0 ) CALL FI_ERROR("Cant reduce dimension "//TRIM(DIMNAME_BT)//" for basetime for variable "//TRIM(VARNAME))
  320       IF ( .NOT.ALLOCATED(ZBASETIME)) ALLOCATE(ZBASETIME(1))
  321       IERR=FIO%READ(TRIM(DIMNAME_BT),ZBASETIME,"seconds since 1970-01-01 00:00:00 +00:00")
  322       IF ( IERR /= 0 ) CALL FI_ERROR("Can't read basetime for variable "//TRIM(VARNAME))
  323       BASETIME=ZBASETIME(1)
  324     ENDIF
  325   ENDIF
  326 
  327 END SUBROUTINE FI_GET_DIMENSIONS
  328 
  329 SUBROUTINE FI_READ_FIELD(FIO,VARNAME,NX,NY,FIELD,STEP,REL,LEVEL,TIME,BASETIME,CUNIT,LCONT_ON_ERROR,VERBOSITY)
  330   USE FIMEX     ,ONLY : FimexIO
  331   USE FIMEX2D    ,ONLY : FI_GET_DIMENSIONS,EPOCH2DTG,XUNDEF,RKIND,IKIND
  332   IMPLICIT NONE
  333   TYPE(FimexIO),                     INTENT(INOUT)           :: FIO
  334   CHARACTER(LEN=*),                  INTENT(IN)              :: VARNAME
  335   INTEGER(KIND=IKIND),               INTENT(IN)              :: NX
  336   INTEGER(KIND=IKIND),               INTENT(IN)              :: NY
  337   REAL(KIND=RKIND),DIMENSION(NX,NY), INTENT(OUT)             :: FIELD
  338   INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: STEP
  339   INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: REL
  340   INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: LEVEL
  341   REAL(KIND=RKIND),                  INTENT(OUT),  OPTIONAL  :: TIME
  342   REAL(KIND=RKIND),                  INTENT(OUT),  OPTIONAL  :: BASETIME
  343   CHARACTER(LEN=*),                  INTENT(IN),   OPTIONAL  :: CUNIT
  344   LOGICAL,                           INTENT(INOUT),OPTIONAL  :: LCONT_ON_ERROR
  345   INTEGER(KIND=IKIND),               INTENT(IN),   OPTIONAL  :: VERBOSITY
  346   INTEGER(KIND=IKIND)                                        :: NX_VAR,NY_VAR,NZ,NREL,NTIMES
  347   CHARACTER(LEN=1024)                                        :: DIMNAME_T,DIMNAME_X,DIMNAME_Y,DIMNAME_Z,DIMNAME_R
  348   REAL(KIND=RKIND),DIMENSION(:),ALLOCATABLE,TARGET           :: ZTIME
  349   REAL(KIND=8),DIMENSION(:),ALLOCATABLE,TARGET               :: ZFIELD
  350   REAL(KIND=8),DIMENSION(:,:),POINTER                        :: ZFIELD2D
  351   REAL(KIND=RKIND)                                           :: BTIME
  352   INTEGER(KIND=IKIND)                                        :: NDIMS,IERR,I,VERB
  353   LOGICAL                                                    :: X_GEO,Y_GEO
  354   LOGICAL                                                    :: LCONTINUE_ON_ERROR
  355 
  356   VERB=0
  357   IF (PRESENT(VERBOSITY)) VERB=VERBOSITY
  358   LCONTINUE_ON_ERROR=.FALSE.
  359   IF(PRESENT(LCONT_ON_ERROR)) LCONTINUE_ON_ERROR=.FALSE.
  360 
  361   IF ( VERB > 0 ) WRITE(*,*) "READING "//TRIM(varName)
  362   CALL FI_GET_DIMENSIONS(FIO,VARNAME,NX=NX_VAR,NY=NY_VAR,NZ=NZ,NREL=NREL,NTIMES=NTIMES,&
  363                          X_GEO=X_GEO,Y_GEO=Y_GEO,DIMNAME_X=DIMNAME_X,DIMNAME_Y=DIMNAME_Y,&
  364                          DIMNAME_Z=DIMNAME_Z,DIMNAME_T=DIMNAME_T,DIMNAME_R=DIMNAME_R,&
  365                          BASETIME=BTIME,VERBOSITY=VERB)
  366 
  367   ! Create slice builder and reduce to wanted dimensions
  368   NDIMS=FIO%GET_DIMENSIONS(TRIM(VARNAME))
  369   IF ( NDIMS <= 0 ) CALL FI_ERROR("Can't make slicebuilder for reading of variable"//TRIM(VARNAME))
  370   IF ( TRIM(DIMNAME_Z) /= "NA" ) THEN
  371     IF ( PRESENT(level)) THEN
  372       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_Z), LEVEL, 1)
  373       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  374     ELSE
  375       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_Z), 0, 1)
  376       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  377     ENDIF
  378   ELSE
  379     IF (PRESENT(level)) CALL FI_ERROR("You try to read a level but the variable does not have a vertical axis!")
  380   ENDIF
  381   ! Realization (EPS)
  382   IF ( TRIM(DIMNAME_R) /= "NA" ) THEN
  383     IF (PRESENT(REL)) THEN
  384       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_R),REL, 1)
  385       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  386     ELSE
  387       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_R), 0, 1)
  388       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  389     ENDIF
  390   ENDIF
  391   IF ( TRIM(DIMNAME_T) /= "NA" ) THEN
  392     IF (PRESENT(STEP)) THEN
  393       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_T),STEP,1)
  394       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  395     ELSE
  396       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_T),0,1)
  397       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  398     ENDIF
  399   ENDIF
  400 
  401   IF (( NX /= NX_VAR ) .OR. ( NY /= NY_VAR )) CALL FI_ERROR("Mismatch in dimensions for variable "//TRIM(VARNAME))
  402   IF (.NOT.ALLOCATED(ZFIELD)) ALLOCATE(ZFIELD(NX*NY))
  403   ALLOCATE(ZFIELD2D(NX,NY))
  404   FIELD=0.
  405   IF ( PRESENT (CUNIT)) THEN
  406     IERR=FIO%READ(VARNAME,ZFIELD,CUNIT)
  407     IF ( IERR /= 0 ) CALL FI_ERROR("Can't read variable "//TRIM(VARNAME))
  408   ELSE
  409     IERR=FIO%READ(VARNAME,ZFIELD)
  410     IF ( IERR /= 0 ) CALL FI_ERROR("Can't read variable "//TRIM(VARNAME))
  411   ENDIF
  412   ZFIELD2D(1:NX,1:NY) => ZFIELD
  413   FIELD(1:NX,1:NY)=REAL(ZFIELD2D(1:NX,1:NY),KIND=RKIND)
  414   NULLIFY(ZFIELD2D)
  415 
  416   ! Find time in file
  417   IF ( TRIM(DIMNAME_T) /= "NA" ) THEN
  418     IF (PRESENT(BASETIME)) BASETIME=BTIME
  419     IF (PRESENT(TIME)) THEN
  420       IF ( TRIM(DIMNAME_T) == "NA" ) THEN
  421         WRITE(*,*) "Dimension name for time dimension not found"
  422         TIME=-1
  423       ELSE
  424         ! Create slice builder for time variable
  425         NDIMS=FIO%GET_DIMENSIONS(DIMNAME_T)
  426         IF ( NDIMS <= 0 ) CALL FI_ERROR("Can't get dimensions for variable "//TRIM(DIMNAME_T))
  427         IERR=FIO%REDUCE_DIMENSION(DIMNAME_T,STEP,1)
  428         IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(DIMNAME_T)//" for time for variable "//TRIM(VARNAME))
  429         IF ( .NOT.ALLOCATED(ZTIME)) ALLOCATE(ZTIME(1))
  430         IERR=FIO%READ(TRIM(DIMNAME_T),ZTIME,"seconds since 1970-01-01 00:00:00 +00:00")
  431         IF ( IERR /= 0 ) CALL FI_ERROR("Can't read time for variable "//TRIM(VARNAME))
  432         TIME=ZTIME(1)
  433       ENDIF
  434     ENDIF
  435   ELSE
  436     ! If the field does not have a time dimension
  437     ! we set the return value to undefined
  438     IF (PRESENT(BASETIME)) BASETIME=-1
  439     IF (PRESENT(TIME)) TIME=-1
  440   ENDIF
  441   IF ( VERB > 1 ) THEN
  442     IF ( TIME > 0 ) THEN
  443        WRITE(*,*) TRIM(VARNAME),EPOCH2DTG(TIME),MINVAL(FIELD),MAXVAL(FIELD),SUM(REAL(FIELD))/REAL(NX*NY)
  444     ELSE
  445        WRITE(*,*) TRIM(VARNAME),MINVAL(FIELD),MAXVAL(FIELD),SUM(REAL(FIELD))/REAL(NX*NY)
  446     ENDIF
  447   ENDIF
  448 END SUBROUTINE FI_READ_FIELD
  449 
  450 SUBROUTINE FI_WRITE_FIELD(FIO,VARNAME,NX,NY,OUTFIELD,STEP,REL,LEVEL,CUNIT,VERBOSITY)
  451   USE FIMEX, ONLY                                            : FimexIO
  452   USE FIMEX2D, ONLY                                           : FI_GET_DIMENSIONS,RKIND,IKIND
  453   IMPLICIT NONE
  454   TYPE(FimexIO),                    INTENT(INOUT)           :: FIO
  455   CHARACTER(len=*),                 INTENT(IN)              :: VARNAME
  456   INTEGER(KIND=IKIND),              INTENT(IN)              :: NX
  457   INTEGER(KIND=IKIND),              INTENT(IN)              :: NY
  458   REAL(KIND=RKIND),DIMENSION(NX,NY),INTENT(IN)              :: OUTFIELD
  459   INTEGER(KIND=IKIND),              INTENT(IN),   OPTIONAL  :: STEP
  460   INTEGER(KIND=IKIND),              INTENT(IN),   OPTIONAL  :: REL
  461   INTEGER(KIND=IKIND),              INTENT(IN),   OPTIONAL  :: LEVEL
  462   CHARACTER(LEN=*),                 INTENT(IN),   OPTIONAL  :: CUNIT
  463   INTEGER(KIND=IKIND),              INTENT(IN),   OPTIONAL  :: VERBOSITY
  464   REAL(KIND=RKIND),DIMENSION(NX*NY)                         :: OUTFIELD1D
  465   INTEGER(KIND=IKIND)                                       :: NDIMS,IERR,I,II,J,VERB
  466   REAL(KIND=8),DIMENSION(:),ALLOCATABLE,TARGET              :: ZFIELD
  467   INTEGER(KIND=IKIND)                                       :: NX2,NY2,NZ,NREL,NTIMES
  468   CHARACTER(LEN=1024)                                       :: DIMNAME_T,DIMNAME_X,DIMNAME_Y,DIMNAME_Z,DIMNAME_R
  469 
  470   VERB=0
  471   IF (PRESENT(VERBOSITY)) VERB=VERBOSITY
  472 
  473   IF ( VERB > 0 ) WRITE(*,*) "WRITING: ",TRIM(VARNAME)
  474   CALL FI_GET_DIMENSIONS(FIO,VARNAME,NX=NX2,NY=NY2,NZ=NZ,NREL=NREL,NTIMES=NTIMES,&
  475                          DIMNAME_X=DIMNAME_X,DIMNAME_Y=DIMNAME_Y,&
  476                          DIMNAME_Z=DIMNAME_Z,DIMNAME_T=DIMNAME_T,DIMNAME_R=DIMNAME_R,&
  477                          VERBOSITY=VERB)
  478 
  479   ! Create slice builder and reduce to wanted dimensions
  480   NDIMS=FIO%GET_DIMENSIONS(TRIM(VARNAME))
  481   IF ( NDIMS <= 0 ) CALL FI_ERROR("Can't make slicebuilder for writing of variable "//TRIM(VARNAME))
  482   IF ( TRIM(DIMNAME_Z) /= "NA" ) THEN
  483     IF ( PRESENT(level)) THEN
  484       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_Z), LEVEL, 1)
  485       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  486     ELSE
  487       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_Z), 0, 1)
  488       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  489     ENDIF
  490   ELSE
  491     IF (PRESENT(level)) CALL FI_ERROR("You try to read a level but the variable does not have a vertical axis!")
  492   ENDIF
  493   ! Realization (EPS)
  494   IF ( TRIM(DIMNAME_R) /= "NA" ) THEN
  495     IF (PRESENT(REL)) THEN
  496       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_R),REL, 1)
  497       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  498     ELSE
  499       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_R), 0, 1)
  500       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  501     ENDIF
  502   ENDIF
  503   IF ( TRIM(DIMNAME_T) /= "NA" ) THEN
  504     IF (PRESENT(STEP)) THEN
  505       IF ( STEP >= NTIMES ) THEN
  506         CALL FI_ERROR("You try to write a step which is larger than the maximum steps for the slicebuilder")
  507       ENDIF
  508       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_T),STEP,1)
  509       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  510     ELSE
  511       IERR=FIO%REDUCE_DIMENSION(TRIM(DIMNAME_T),0,1)
  512       IF ( IERR /= 0 ) CALL FI_ERROR("Can't reduce dimension "//TRIM(FIO%GET_DIMNAME(I))//" for variable "//TRIM(VARNAME))
  513     ENDIF
  514   ENDIF
  515 
  516   ! Modify 2D field to 1D
  517   II=1
  518   DO J=1,NY
  519     DO I=1,NX
  520       OUTFIELD1D(II)=OUTFIELD(I,J)
  521       II=II+1
  522     ENDDO
  523   ENDDO
  524   ALLOCATE(ZFIELD(NX*NY))
  525   ZFIELD=OUTFIELD1D
  526   IF ( PRESENT (CUNIT)) THEN
  527     IERR=FIO%WRITE(VARNAME,ZFIELD,CUNIT)
  528     IF ( IERR /= 0 ) CALL FI_ERROR("Can't write variable "//TRIM(VARNAME))
  529   ELSE
  530     IERR=FIO%WRITE(VARNAME,ZFIELD)
  531     IF ( IERR /= 0 ) CALL FI_ERROR("Can't write variable "//TRIM(VARNAME))
  532   ENDIF
  533   IF ( VERB > 1 ) WRITE(*,*) TRIM(VARNAME),MINVAL(ZFIELD),MAXVAL(ZFIELD),SUM(REAL(ZFIELD))/REAL(SIZE(ZFIELD))
  534   DEALLOCATE(ZFIELD)
  535 END SUBROUTINE
  536