From 1df2f2466230ef50b15ac1c27b00d06002cd3cbb Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Mon, 25 Sep 2017 15:33:17 +0200
Subject: [PATCH] Philippe 25/09/2017: IO: remove FMREAD and FMWRIT subroutines
and all their dependencies
---
src/LIB/SURCOUCHE/src/extern_userio.f90 | 687 ----
src/LIB/SURCOUCHE/src/fmread_ll.f90 | 2166 +-----------
src/LIB/SURCOUCHE/src/fmreadwrit.f90 | 260 +-
src/LIB/SURCOUCHE/src/fmwrit_ll.f90 | 4210 +++++------------------
src/LIB/SURCOUCHE/src/mode_netcdf.f90 | 1361 +-------
src/LIB/SURCOUCHE/src/modi_fmread.f90 | 224 --
src/LIB/SURCOUCHE/src/modi_fmwrit.f90 | 301 --
src/MNH/mnh2lpdm_ech.f90 | 1 -
src/MNH/mnh2lpdm_ini.f90 | 1 -
9 files changed, 1014 insertions(+), 8197 deletions(-)
delete mode 100644 src/LIB/SURCOUCHE/src/modi_fmread.f90
delete mode 100644 src/LIB/SURCOUCHE/src/modi_fmwrit.f90
diff --git a/src/LIB/SURCOUCHE/src/extern_userio.f90 b/src/LIB/SURCOUCHE/src/extern_userio.f90
index 85746e3d2..20cfadc62 100644
--- a/src/LIB/SURCOUCHE/src/extern_userio.f90
+++ b/src/LIB/SURCOUCHE/src/extern_userio.f90
@@ -165,693 +165,6 @@ ELSE
ENDIF
END SUBROUTINE FMCLOS_ll
-
-!
-! Routines found in the MODE_FMREAD module : FMREADxxx
-!
-SUBROUTINE FMREADX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADX0_ll=>FMREADX0_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL, INTENT(OUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADX0_ll
-
-SUBROUTINE FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll)
-USE MODE_FMREAD, ONLY : E_FMREADX1_ll=>FMREADX1_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-REAL,DIMENSION(:),TARGET,INTENT(OUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
-INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
-
-IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
- CALL E_FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP,KIMAX_ll,KJMAX_ll)
-ELSE
- CALL E_FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-ENDIF
-
-END SUBROUTINE FMREADX1_ll
-
-SUBROUTINE FMREADX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADX2_ll=>FMREADX2_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:),TARGET, INTENT(OUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADX2_ll
-
-SUBROUTINE FMREADX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADX3_ll=>FMREADX3_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL, DIMENSION(:,:,:),TARGET,INTENT(OUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADX3_ll
-
-SUBROUTINE FMREADX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADX4_ll=>FMREADX4_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:),TARGET,INTENT(OUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code if
-
-CALL E_FMREADX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADX4_ll
-
-SUBROUTINE FMREADX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADX5_ll=>FMREADX5_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(OUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADX5_ll
-
-SUBROUTINE FMREADX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADX6_ll=>FMREADX6_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(OUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADX6_ll
-
-SUBROUTINE FMREADN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADN0_ll=>FMREADN0_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-INTEGER, INTENT(OUT)::KFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADN0_ll
-
-SUBROUTINE FMREADN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADN1_ll=>FMREADN1_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-INTEGER,DIMENSION(:),TARGET,INTENT(OUT)::KFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADN1_ll
-
-SUBROUTINE FMREADN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADN2_ll=>FMREADN2_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-INTEGER, DIMENSION(:,:),TARGET,INTENT(OUT)::KFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADN2_ll
-
-SUBROUTINE FMREADL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADL0_ll=>FMREADL0_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-LOGICAL, INTENT(OUT)::OFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADL0_ll
-
-SUBROUTINE FMREADL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADL1_ll=>FMREADL1_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-LOGICAL, DIMENSION(:), INTENT(OUT)::OFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADL1_ll
-
-SUBROUTINE FMREADC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADC0_ll=>FMREADC0_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-CHARACTER(LEN=*), INTENT(OUT)::HFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADC0_ll
-
-SUBROUTINE FMREADT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREADT0_ll=>FMREADT0_ll
-USE MODD_TYPE_DATE
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-TYPE (DATE_TIME), INTENT(OUT)::TFIELD ! array containing the data field
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREADT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREADT0_ll
-
-SUBROUTINE FMREAD_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
- & KGRID,KLENCH,HCOMMENT,KRESP)
-USE MODE_FMREAD, ONLY : E_FMREAD_LB=>FMREAD_LB
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints
-CHARACTER(LEN=*), INTENT(IN) ::HLBTYPE ! 'LBX','LBXU','LBY' or 'LBYV'
-REAL, DIMENSION(:,:,:),TARGET, INTENT(OUT)::PLB ! array containing the LB field
-INTEGER, INTENT(IN) :: KRIM ! size of the LB area
-INTEGER, INTENT(IN) :: KL3D ! size of the LB array in FM
-INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(OUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMREAD_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMREAD_LB
-
-!
-! Routines found in the MODE_FMWRIT module : FMWRITxxx
-!
-SUBROUTINE FMWRITX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITX0_ll=>FMWRITX0_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL, INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITX0_ll
-
-SUBROUTINE FMWRITX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITX1_ll=>FMWRITX1_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITX1_ll
-
-SUBROUTINE FMWRITX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITX2_ll=>FMWRITX2_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITX2_ll
-
-SUBROUTINE FMWRITX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITX3_ll=>FMWRITX3_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITX3_ll
-
-SUBROUTINE FMWRITX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITX4_ll=>FMWRITX4_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITX4_ll
-
-SUBROUTINE FMWRITX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITX5_ll=>FMWRITX5_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITX5_ll
-
-SUBROUTINE FMWRITX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITX6_ll=>FMWRITX6_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITX6_ll
-
-SUBROUTINE FMWRITN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITN0_ll=>FMWRITN0_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-INTEGER, INTENT(IN) ::KFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITN0_ll
-
-SUBROUTINE FMWRITN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITN1_ll=>FMWRITN1_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-INTEGER,DIMENSION(:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITN1_ll
-
-SUBROUTINE FMWRITN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITN2_ll=>FMWRITN2_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITN2_ll
-
-SUBROUTINE FMWRITL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITL0_ll=>FMWRITL0_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-LOGICAL, INTENT(IN) ::OFIELD ! array containing the data field
-INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITL0_ll
-
-SUBROUTINE FMWRITL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITL1_ll=>FMWRITL1_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-LOGICAL,DIMENSION(:),INTENT(IN) ::OFIELD ! array containing the data field
-INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITL1_ll
-
-SUBROUTINE FMWRITC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITC0_ll=>FMWRITC0_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-CHARACTER(LEN=*), INTENT(IN) ::HFIELD ! array containing the data field
-INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITC0_ll
-
-SUBROUTINE FMWRITC1_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITC1_ll=>FMWRITC1_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-CHARACTER(LEN=*),DIMENSION(:), INTENT(IN) ::HFIELD ! array containing the data field
-INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITC1_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITC1_ll
-
-SUBROUTINE FMWRITT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITT0_ll=>FMWRITT0_ll
-USE MODD_TYPE_DATE
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-TYPE (DATE_TIME), INTENT(IN) ::TFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRITT0_ll
-
-SUBROUTINE FMWRIT_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
- & KGRID,KLENCH,HCOMMENT,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRIT_LB=>FMWRIT_LB
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints in FM
-CHARACTER(LEN=*), INTENT(IN) ::HLBTYPE! 'LBX','LBXU','LBY' or 'LBYV'
-REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PLB ! array containing the LB field
-INTEGER, INTENT(IN) ::KRIM ! size of the LB area
-INTEGER, INTENT(IN) ::KL3D ! size of the LB array in FM
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(IN) ::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRIT_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,KGRID,KLENCH,HCOMMENT,KRESP)
-
-END SUBROUTINE FMWRIT_LB
-
-SUBROUTINE FMWRITBOXX2_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITBOXX2_ll=>FMWRITBOXX2_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
-REAL,DIMENSION(:,:),TARGET, INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(IN) ::KXOBOX !
-INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
-INTEGER, INTENT(IN) ::KYOBOX !
-INTEGER, INTENT(IN) ::KYEBOX !
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITBOXX2_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
-
-END SUBROUTINE FMWRITBOXX2_ll
-
-SUBROUTINE FMWRITBOXX3_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITBOXX3_ll=>FMWRITBOXX3_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
-REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(IN) ::KXOBOX !
-INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
-INTEGER, INTENT(IN) ::KYOBOX !
-INTEGER, INTENT(IN) ::KYEBOX !
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITBOXX3_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
-
-END SUBROUTINE FMWRITBOXX3_ll
-
-SUBROUTINE FMWRITBOXX4_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITBOXX4_ll=>FMWRITBOXX4_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
-REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(IN) ::KXOBOX !
-INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
-INTEGER, INTENT(IN) ::KYOBOX !
-INTEGER, INTENT(IN) ::KYEBOX !
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITBOXX4_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
-
-END SUBROUTINE FMWRITBOXX4_ll
-
-SUBROUTINE FMWRITBOXX5_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITBOXX5_ll=>FMWRITBOXX5_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
-REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(IN) ::KXOBOX !
-INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
-INTEGER, INTENT(IN) ::KYOBOX !
-INTEGER, INTENT(IN) ::KYEBOX !
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITBOXX5_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
-
-END SUBROUTINE FMWRITBOXX5_ll
-
-SUBROUTINE FMWRITBOXX6_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
-USE MODE_FMWRIT, ONLY : E_FMWRITBOXX6_ll=>FMWRITBOXX6_ll
-IMPLICIT NONE
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
-REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
-INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
-CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
-INTEGER, INTENT(IN) ::KXOBOX !
-INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
-INTEGER, INTENT(IN) ::KYOBOX !
-INTEGER, INTENT(IN) ::KYEBOX !
-INTEGER, INTENT(OUT)::KRESP ! return-code
-
-CALL E_FMWRITBOXX6_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
-
-END SUBROUTINE FMWRITBOXX6_ll
!
! Routines found in the MODE_GATHER_ll module : GATHERALL_xx
!
diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90
index 81b46b2aa..135602716 100644
--- a/src/LIB/SURCOUCHE/src/fmread_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90
@@ -65,58 +65,9 @@ INTERFACE IO_READ_FIELD_LB
MODULE PROCEDURE IO_READ_FIELD_BYNAME_LB, IO_READ_FIELD_BYFIELD_LB
END INTERFACE
-INTERFACE FMREAD
- MODULE PROCEDURE FMREADX0_ll,FMREADX1_ll,FMREADX2_ll,FMREADX3_ll,&
- & FMREADX4_ll,FMREADX5_ll,FMREADX6_ll,&
- & FMREADN0_ll,FMREADN1_ll,FMREADN2_ll,&
- & FMREADL0_ll,FMREADL1_ll,FMREADC0_ll,FMREADT0_ll
-END INTERFACE
-!
-
-PUBLIC FMREAD_LB,FMREAD,FMREADX0_ll,FMREADX1_ll,FMREADX2_ll,FMREADX3_ll,&
- & FMREADX4_ll,FMREADX5_ll,FMREADX6_ll,&
- & FMREADN0_ll,FMREADN1_ll,FMREADN2_ll,&
- & FMREADL0_ll,FMREADL1_ll,FMREADC0_ll,FMREADT0_ll
PUBLIC IO_READ_FIELD,IO_READ_FIELD_LB
CONTAINS
-SUBROUTINE FM_READ_ERR(HFUNC,HFILEM,HFIPRI,HRECFM,HDIR,KRESP)
-USE MODE_FM, ONLY : FMLOOK_ll
-
-CHARACTER(LEN=*) :: HFUNC
-CHARACTER(LEN=*) :: HFILEM
-CHARACTER(LEN=*) :: HFIPRI
-CHARACTER(LEN=*) :: HRECFM
-CHARACTER(LEN=*) :: HDIR
-INTEGER :: KRESP
-
-INTEGER :: ILUPRI
-INTEGER :: IRESP
-
-CALL FMLOOK_ll(HFIPRI,HFIPRI,ILUPRI,IRESP)
-WRITE (ILUPRI,*) ' exit from ',HFUNC, ' with RESP:',KRESP
-!STOP "fmread_ll.f90:: FM_READ_ERR"
-
-WRITE (ILUPRI,*) ' | HFILEM = ',HFILEM
-WRITE (ILUPRI,*) ' | HRECFM = ',HRECFM
-WRITE (ILUPRI,*) ' | HDIR = ',HDIR
-
-END SUBROUTINE FM_READ_ERR
-
-
-SUBROUTINE BCAST_HEADER(TPFD,TPFMH)
-USE MODE_FD_ll, ONLY : FD_ll
-USE MODD_FM
-TYPE(FD_ll), POINTER :: TPFD
-TYPE(FMHEADER), INTENT(INOUT) :: TPFMH
-
-INTEGER :: ierr
-
-CALL MPI_BCAST(TPFMH%GRID,1,MPI_INTEGER,TPFD%OWNER-1,TPFD%COMM,IERR)
-CALL MPI_BCAST(TPFMH%COMLEN,1,MPI_INTEGER,TPFD%OWNER-1,TPFD%COMM,IERR)
-CALL MPI_BCAST(TPFMH%COMMENT,TPFMH%COMLEN,MPI_CHARACTER,TPFD%OWNER-1,TPFD%COMM,IERR)
-
-END SUBROUTINE BCAST_HEADER
SUBROUTINE IO_BCAST_FIELD_METADATA(TPFD,TPFIELD)
USE MODE_FD_ll, ONLY : FD_ll
@@ -140,85 +91,6 @@ CALL MPI_BCAST(TPFIELD%NDIMS, 1, MPI_INTEGER, TPFD%OWNER
!
END SUBROUTINE IO_BCAST_FIELD_METADATA
-SUBROUTINE FMREADX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL, INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-!----------------------------------------------------------------
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-TYPE(FMHEADER) :: TZFMH
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADX0_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- CALL MPI_BCAST(PFIELD,1,MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADX0_ll
SUBROUTINE IO_READ_FIELD_BYNAME_X0(TPFILE,HNAME,PFIELD,KRESP)
!
@@ -315,118 +187,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_X0
-SUBROUTINE FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC, ISNPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-REAL,DIMENSION(:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
-INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
-TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
-!
-!* 0.2 Declarations of local variables
-!
-!----------------------------------------------------------------
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADX1_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC, KIMAX_ll, KJMAX_ll)
- ELSE
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ENDIF
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0))
- GALLOC = .TRUE.
- END IF
-
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR /= 'XX' .AND. HDIR /='YY') THEN
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- ELSE
- !Scatter Field
- IF( PRESENT(TPSPLITTING) ) THEN
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
- ELSE
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ENDIF
- END IF
- END IF !(GSMONOPROC)
-
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-KRESP = IRESP
-RETURN
-!------------------------------------------------------------------
-END SUBROUTINE FMREADX1_ll
-
SUBROUTINE IO_READ_FIELD_BYNAME_X1(TPFILE,HNAME,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
!
USE MODD_IO_ll, ONLY : ISNPROC
@@ -545,197 +305,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_X1
-SUBROUTINE FMREADX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll, TPSPLITTING)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D , ISNPROC
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-!JUANZ
-USE MODD_TIMEZ, ONLY : TIMEZ
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
-!JUANZ
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-#ifdef MNH_GA
- USE MODE_GA
-#endif
-
-IMPLICIT NONE
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:),TARGET, INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
-INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
-TYPE(ZONE_ll), DIMENSION(ISNPROC), OPTIONAL :: TPSPLITTING ! splitting of the domain
-!
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:), POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!JUANZ
-REAL*8,DIMENSION(2) :: T0,T1,T2
-REAL*8,DIMENSION(2) :: T11,T22
-!JUANZ
-#ifdef MNH_GA
-REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
-#endif
-INTEGER :: IHEXTOT
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADX2_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-CALL SECOND_MNH2(T11)
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-
-!------------------------------------------------------------------
-IHEXTOT = 2*JPHEXT+1
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
-! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
-! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:)=SPREAD(PFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- CALL SECOND_MNH2(T0)
- IF (ISP == TZFD%OWNER) THEN
- ! I/O processor case
- IF( PRESENT(KIMAX_ll) .AND. PRESENT(KJMAX_ll) ) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC, KIMAX_ll, KJMAX_ll)
- ELSE
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ENDIF
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ2D_READ=TIMEZ%T_READ2D_READ + T1 - T0
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- IF( PRESENT(TPSPLITTING) ) THEN
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM,TPSPLITTING)
- ELSE
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ENDIF
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- IF( PRESENT(TPSPLITTING) ) THEN
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,JPHEXT+1),TZFD%OWNER,TZFD%COMM,TPSPLITTING)
- ELSE
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,JPHEXT+1),TZFD%OWNER,TZFD%COMM)
- ENDIF
- PFIELD(:,:) = SPREAD(PFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
- ELSE
-#ifdef MNH_GA
- !
- ! init/create the ga , dim3 = 1
- !
- CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),1,HRECFM,"READ")
- IF (ISP == TZFD%OWNER) THEN
- !
- ! put the data in the g_a , this proc get this 1 slide
- !
- lo_zplan(JPIZ) = 1
- hi_zplan(JPIZ) = 1
- call nga_put(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
- END IF
- call ga_sync
- !
- ! get the columun data in this proc
- !
- ! temp buf to avoid problem with none stride PFIELDS buffer with HALO
- ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
- call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1) , ld_col)
- PFIELD = ZFIELD_GA
- DEALLOCATE(ZFIELD_GA)
-#else
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
-#endif
- END IF
- ELSE
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- CALL SECOND_MNH2(T2)
- TIMEZ%T_READ2D_SCAT=TIMEZ%T_READ2D_SCAT + T2 - T1
- END IF !(GSMONOPROC)
-
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX2_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-KRESP = IRESP
-!------------------------------------------------------------------
-
-CALL SECOND_MNH2(T22)
-TIMEZ%T_READ2D_ALL=TIMEZ%T_READ2D_ALL + T22 - T11
-
-END SUBROUTINE FMREADX2_ll
-
SUBROUTINE IO_READ_FIELD_BYNAME_X2(TPFILE,HNAME,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
!
USE MODD_IO_ll, ONLY : ISNPROC
@@ -915,430 +484,75 @@ TIMEZ%T_READ2D_ALL=TIMEZ%T_READ2D_ALL + T22 - T11
END SUBROUTINE IO_READ_FIELD_BYFIELD_X2
-SUBROUTINE FMREADX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-!JUANZ
-USE MODD_IO_ll, ONLY : ISNPROC
-USE MODE_IO_ll, ONLY : io_file,io_rank
-USE MODD_TIMEZ, ONLY : TIMEZ
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
-!JUANZ
-#ifdef MNH_GA
- USE MODE_GA
-#endif
-USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
-
-IMPLICIT NONE
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL, DIMENSION(:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
+SUBROUTINE IO_READ_FIELD_BYNAME_X3(TPFILE,HNAME,PFIELD,KRESP)
!
-#ifdef MNH_GA
-REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
-#endif
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+REAL,DIMENSION(:,:,:),INTENT(INOUT) :: PFIELD ! array containing the data field
+INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
+INTEGER :: ID ! Index of the field
+INTEGER :: IRESP ! return_code
!
-!* 0.2 Declarations of local variables
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!JUAN
-INTEGER :: JK,JKK
-CHARACTER(LEN=LEN(HRECFM)) :: YK,YRECZSLIDE
-REAL,DIMENSION(:,:),POINTER :: ZSLIDE_ll,ZSLIDE
-INTEGER :: IK_FILE,IK_rank,inb_proc_real,JK_MAX
-CHARACTER(len=5) :: YK_FILE
-CHARACTER(len=128) :: YFILE_IOZ
-TYPE(FD_ll), POINTER :: TZFD_IOZ
-INTEGER :: JI,IXO,IXE,IYO,IYE
-REAL,DIMENSION(:,:),POINTER :: TX2DP
-INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
-LOGICAL :: GALLOC_ll
+CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+!
+IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+!
+IF (PRESENT(KRESP)) KRESP = IRESP
+!
+END SUBROUTINE IO_READ_FIELD_BYNAME_X3
-INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
-INTEGER :: NB_REQ
+SUBROUTINE IO_READ_FIELD_BYFIELD_X3(TPFILE,TPFIELD,PFIELD,KRESP)
+!
+USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,ISNPROC,LPACK,L1D,L2D
+USE MODD_TIMEZ, ONLY : TIMEZ
+USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+!
+USE MODE_ALLOCBUFFER_ll
+USE MODE_FD_ll, ONLY : GETFD,FD_LL
+USE MODE_IO_ll, ONLY : IO_FILE
+USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_FIND_BYNAME
+USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+USE MODE_SCATTER_ll
+!
+TYPE(TFILEDATA),TARGET, INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+REAL,DIMENSION(:,:,:),TARGET,INTENT(INOUT) :: PFIELD ! array containing the data field
+INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+!
TYPE TX_2DP
- REAL,DIMENSION(:,:), POINTER :: X
+ REAL,DIMENSION(:,:), POINTER :: X
END TYPE TX_2DP
+!
+INTEGER :: IERR,IRESP
+INTEGER :: IHEXTOT
+INTEGER :: IK_FILE,IK_RANK,INB_PROC_REAL,JK_MAX
+INTEGER :: JI,IXO,IXE,IYO,IYE
+INTEGER :: JK,JKK
+INTEGER :: NB_REQ
+INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
+LOGICAL :: GALLOC, GALLOC_ll
+REAL,DIMENSION(:,:),POINTER :: TX2DP
+REAL,DIMENSION(:,:),POINTER :: ZSLICE_ll,ZSLICE
+REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
+REAL(KIND=8),DIMENSION(2) :: T0,T1,T2
+REAL(KIND=8),DIMENSION(2) :: T11,T22
+CHARACTER(LEN=2) :: YDIR
+CHARACTER(LEN=128) :: YFILE_IOZ
+CHARACTER(LEN=4) :: YK
+CHARACTER(LEN=5) :: YK_FILE
+CHARACTER(LEN=NMNHNAMELGTMAX+4) :: YRECZSLICE
+CHARACTER(LEN=4) :: YSUFFIX
+TYPE(FD_ll), POINTER :: TZFD
+TYPE(FD_ll), POINTER :: TZFD_IOZ
+TYPE(TFILEDATA),POINTER :: TZFILE
+TYPE(TFIELDDATA) :: TZFIELD
TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
-REAL*8,DIMENSION(2) :: T0,T1,T2
-REAL*8,DIMENSION(2) :: T11,T22
-INTEGER :: IHEXTOT
-!JUAN
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADX3_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-CALL SECOND_MNH2(T11)
-GALLOC = .FALSE.
-GALLOC_ll = .FALSE.
-IRESP = 0
-YFNLFI = TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-IHEXTOT = 2*JPHEXT+1
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC .AND. (TZFD%nb_procio.eq.1) ) THEN ! sequential execution
-! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
-! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ALLOCATE (ZFIELDP(SIZE(PFIELD,1),1,SIZE(PFIELD,3)))
- GALLOC = .TRUE.
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:)=SPREAD(ZFIELDP(:,1,:),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR. ( HDIR == '--' ) ) THEN ! multiprocessor execution & 1 IO proc
- ! read 3D field for graphique
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,JPHEXT+1,:),TZFD%OWNER,TZFD%COMM)
- PFIELD(:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- END IF
- ELSE
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE ! multiprocessor execution & // IO
-!
-!JUAN BG Z SLIDE
-!
-#ifdef MNH_GA
- !
- ! init/create the ga
- !
- CALL SECOND_MNH2(T0)
- CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),HRECFM,"READ")
- !
- ! read the data
- !
- ALLOCATE(ZSLIDE_ll(0,0)) ! to avoid bug on test of size
- GALLOC_ll = .TRUE.
- DO JKK=1,IKU_ll
- IK_FILE = io_file(JKK,TZFD%nb_procio)
- write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
- YFILE_IOZ = TRIM(HFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- !
- IK_RANK = TZFD_IOZ%OWNER
- !
- IF (ISP == IK_RANK ) THEN
- IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
- DEALLOCATE(ZSLIDE_ll)
- CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
- END IF
- !
- CALL SECOND_MNH2(T0)
- WRITE(YK,'(I4.4)') JKK
- YRECZSLIDE = TRIM(HRECFM)//YK
- IF (ASSOCIATED(TZFD_IOZ%CDF)) THEN
- CALL NCREAD(TZFD_IOZ%CDF%NCID,YRECZSLIDE,ZSLIDE_ll,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
- & ,IRESP)
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
- !
- ! put the data in the g_a , this proc get this JKK slide
- !
- lo_zplan(JPIZ) = JKK
- hi_zplan(JPIZ) = JKK
- call nga_put(g_a, lo_zplan, hi_zplan,ZSLIDE_ll, ld_zplan)
- END IF
- END DO
- call ga_sync
- !
- ! get the columun data in this proc
- !
- ! temp buf to avoid problem with none stride PFIELDS buffer with HALO
- ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
- call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1,1) , ld_col)
- PFIELD = ZFIELD_GA
- DEALLOCATE(ZFIELD_GA)
-#else
- ALLOCATE(ZSLIDE_ll(0,0))
- GALLOC_ll = .TRUE.
- inb_proc_real = min(TZFD%nb_procio,ISNPROC)
- Z_SLIDE: DO JK=1,SIZE(PFIELD,3),inb_proc_real
- !
- ! read the data
- !
- JK_MAX=min(SIZE(PFIELD,3),JK+inb_proc_real-1)
- !
- NB_REQ=0
- ALLOCATE(REQ_TAB(ISNPROC-1))
- ALLOCATE(T_TX2DP(ISNPROC-1))
- DO JKK=JK,JK_MAX
- IF (TZFD%NB_PROCIO .GT. 1 ) THEN
- IK_FILE = io_file(JKK,TZFD%nb_procio)
- write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
- YFILE_IOZ = TRIM(HFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- ELSE
- TZFD_IOZ => TZFD
- ENDIF
- IK_RANK = TZFD_IOZ%OWNER
- IF (ISP == IK_RANK ) THEN
- IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
- DEALLOCATE(ZSLIDE_ll)
- CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
- END IF
- !JUAN
- CALL SECOND_MNH2(T0)
- WRITE(YK,'(I4.4)') JKK
- YRECZSLIDE = TRIM(HRECFM)//YK
- IF (ASSOCIATED(TZFD_IOZ%CDF)) THEN
- CALL NCREAD(TZFD_IOZ%CDF%NCID,YRECZSLIDE,ZSLIDE_ll,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
- & ,IRESP)
- END IF
- !JUANIOZ
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
- DO JI = 1,ISNPROC
- CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
- TX2DP=>ZSLIDE_ll(IXO:IXE,IYO:IYE)
- IF (ISP /= JI) THEN
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX2DP(NB_REQ)%X(IXO:IXE,IYO:IYE))
- T_TX2DP(NB_REQ)%X=TX2DP
- CALL MPI_ISEND(T_TX2DP(NB_REQ)%X,SIZE(TX2DP),MPI_FLOAT,JI-1,199+IK_RANK &
- & ,TZFD_IOZ%COMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,199+IK_RANK,TZFD_IOZ%COMM,IERR)
- ELSE
- PFIELD(:,:,JKK) = TX2DP(:,:)
- END IF
- END DO
- CALL SECOND_MNH2(T2)
- TIMEZ%T_READ3D_SEND=TIMEZ%T_READ3D_SEND + T2 - T1
- !JUANIOZ
- END IF
- END DO
- !
- ! brodcast the data
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- STOP " XX ou YY NON PREVU SUR BG POUR LE MOMENT "
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,JPHEXT+1,:),TZFD%OWNER,TZFD%COMM)
- PFIELD(:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- !
- ! XY Scatter Field
- !
- CALL SECOND_MNH2(T0)
- DO JKK=JK,JK_MAX
- !
- ! get the file & rank
- !
- IF (TZFD%NB_PROCIO .GT. 1 ) THEN
- IK_FILE = io_file(JKK,TZFD%nb_procio)
- write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
- YFILE_IOZ = TRIM(HFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- ELSE
- TZFD_IOZ => TZFD
- END IF
- !
- !IK_RANK = 1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
- IK_RANK = TZFD_IOZ%OWNER
- !
- ZSLIDE => PFIELD(:,:,JKK)
-!JUANIOZ
- !CALL SCATTER_XYFIELD(ZSLIDE_ll,ZSLIDE,TZFD_IOZ%OWNER,TZFD_IOZ%COMM)
- IF (ISP .NE. IK_RANK) THEN
- CALL MPI_RECV(ZSLIDE,SIZE(ZSLIDE),MPI_FLOAT,IK_RANK-1,199+IK_RANK,TZFD_IOZ%COMM&
- & ,STATUS,IERR)
- END IF
-!JUAN IOZ
- END DO
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_RECV=TIMEZ%T_READ3D_RECV + T1 - T0
- END IF
- ELSE
- ! Broadcast Field
- STOP " Broadcast Field NON PREVU SUR BG POUR LE MOMENT "
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- CALL SECOND_MNH2(T0)
- IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- DO JI=1,NB_REQ ; DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
- END IF
- DEALLOCATE(T_TX2DP)
- DEALLOCATE(REQ_TAB)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_WAIT=TIMEZ%T_READ3D_WAIT + T1 - T0
- END DO Z_SLIDE
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
-#endif
-!JUAN BG Z SLIDE
- END IF !(GSMONOPROC)
-
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX3_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-IF (GALLOC_ll) DEALLOCATE (ZSLIDE_ll)
-!IF (ASSOCIATED(ZSLIDE_ll)) DEALLOCATE (ZSLIDE_ll)
-KRESP = IRESP
-CALL MPI_BARRIER(TZFD%COMM,IERR)
-CALL SECOND_MNH2(T22)
-TIMEZ%T_READ3D_ALL=TIMEZ%T_READ3D_ALL + T22 - T11
-
-!------------------------------------------------------------------
-END SUBROUTINE FMREADX3_ll
-
-
-SUBROUTINE IO_READ_FIELD_BYNAME_X3(TPFILE,HNAME,PFIELD,KRESP)
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
-REAL,DIMENSION(:,:,:),INTENT(INOUT) :: PFIELD ! array containing the data field
-INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
-!
-INTEGER :: ID ! Index of the field
-INTEGER :: IRESP ! return_code
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
-!
-CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
-!
-IF(IRESP==0) CALL IO_READ_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
-!
-IF (PRESENT(KRESP)) KRESP = IRESP
-!
-END SUBROUTINE IO_READ_FIELD_BYNAME_X3
-
-SUBROUTINE IO_READ_FIELD_BYFIELD_X3(TPFILE,TPFIELD,PFIELD,KRESP)
-!
-USE MODD_IO_ll, ONLY : GSMONOPROC,ISP,ISNPROC,LPACK,L1D,L2D
-USE MODD_TIMEZ, ONLY : TIMEZ
-USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
-!
-USE MODE_ALLOCBUFFER_ll
-USE MODE_FD_ll, ONLY : GETFD,FD_LL
-USE MODE_IO_ll, ONLY : IO_FILE
-USE MODE_IO_MANAGE_STRUCT, ONLY : IO_FILE_FIND_BYNAME
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
-USE MODE_SCATTER_ll
-!
-TYPE(TFILEDATA),TARGET, INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-REAL,DIMENSION(:,:,:),TARGET,INTENT(INOUT) :: PFIELD ! array containing the data field
-INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
-!
-TYPE TX_2DP
- REAL,DIMENSION(:,:), POINTER :: X
-END TYPE TX_2DP
-!
-INTEGER :: IERR,IRESP
-INTEGER :: IHEXTOT
-INTEGER :: IK_FILE,IK_RANK,INB_PROC_REAL,JK_MAX
-INTEGER :: JI,IXO,IXE,IYO,IYE
-INTEGER :: JK,JKK
-INTEGER :: NB_REQ
-INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
-INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
-LOGICAL :: GALLOC, GALLOC_ll
-REAL,DIMENSION(:,:),POINTER :: TX2DP
-REAL,DIMENSION(:,:),POINTER :: ZSLICE_ll,ZSLICE
-REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
-REAL(KIND=8),DIMENSION(2) :: T0,T1,T2
-REAL(KIND=8),DIMENSION(2) :: T11,T22
-CHARACTER(LEN=2) :: YDIR
-CHARACTER(LEN=128) :: YFILE_IOZ
-CHARACTER(LEN=4) :: YK
-CHARACTER(LEN=5) :: YK_FILE
-CHARACTER(LEN=NMNHNAMELGTMAX+4) :: YRECZSLICE
-CHARACTER(LEN=4) :: YSUFFIX
-TYPE(FD_ll), POINTER :: TZFD
-TYPE(FD_ll), POINTER :: TZFD_IOZ
-TYPE(TFILEDATA),POINTER :: TZFILE
-TYPE(TFIELDDATA) :: TZFIELD
-TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYFIELD_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
CALL SECOND_MNH2(T11)
GALLOC = .FALSE.
@@ -1637,130 +851,6 @@ TIMEZ%T_READ3D_ALL=TIMEZ%T_READ3D_ALL + T22 - T11
END SUBROUTINE IO_READ_FIELD_BYFIELD_X3
-SUBROUTINE FMREADX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code if
-!
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-INTEGER :: IHEXTOT
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADX4_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-IHEXTOT = 2*JPHEXT+1
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
-! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1,:,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
-! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:,:)=SPREAD(PFIELD(:,JPHEXT+1,:,:),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:),PFIELD(:,JPHEXT+1,:,:),TZFD%OWNER,TZFD%COMM)
- PFIELD(:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- END IF
- ELSE
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX4_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-KRESP = IRESP
-RETURN
-!------------------------------------------------------------------
-END SUBROUTINE FMREADX4_ll
-
SUBROUTINE IO_READ_FIELD_BYNAME_X4(TPFILE,HNAME,PFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : ISNPROC
@@ -1899,145 +989,21 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_X4
-SUBROUTINE FMREADX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
+SUBROUTINE IO_READ_FIELD_BYNAME_X5(TPFILE,HNAME,PFIELD,KRESP)
!
+USE MODD_IO_ll, ONLY : ISNPROC
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
!
-!* 0.2 Declarations of local variables
!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-INTEGER :: IHEXTOT
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+REAL,DIMENSION(:,:,:,:,:),INTENT(INOUT) :: PFIELD ! array containing the data field
+INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADX5_ll','reading '//TRIM(HRECFM))
+INTEGER :: ID ! Index of the field
+INTEGER :: IRESP ! return_code
!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-IHEXTOT = 2*JPHEXT+1
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
-! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:,:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1,:,:,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
-! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- END IF
- PFIELD(:,:,:,:,:)=SPREAD(PFIELD(:,JPHEXT+1,:,:,:),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:,:),PFIELD(:,JPHEXT+1,:,:,:),&
- & TZFD%OWNER,TZFD%COMM)
- PFIELD(:,:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:,:),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- END IF
- ELSE
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX5_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-KRESP = IRESP
-RETURN
-!------------------------------------------------------------------
-END SUBROUTINE FMREADX5_ll
-
-SUBROUTINE IO_READ_FIELD_BYNAME_X5(TPFILE,HNAME,PFIELD,KRESP)
-!
-USE MODD_IO_ll, ONLY : ISNPROC
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-!
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
-REAL,DIMENSION(:,:,:,:,:),INTENT(INOUT) :: PFIELD ! array containing the data field
-INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
-!
-INTEGER :: ID ! Index of the field
-INTEGER :: IRESP ! return_code
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_BYNAME_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
@@ -2161,100 +1127,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_X5
-SUBROUTINE FMREADX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(INOUT)::PFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADX6_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,PFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,ZFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE IF (HDIR == 'XY') THEN
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(ZFIELDP,PFIELD,TZFD%OWNER,TZFD%COMM)
- ELSE
- ! Broadcast Field
- CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADX6_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-IF (GALLOC) DEALLOCATE (ZFIELDP)
-KRESP = IRESP
-RETURN
-!------------------------------------------------------------------
-END SUBROUTINE FMREADX6_ll
-
SUBROUTINE IO_READ_FIELD_BYNAME_X6(TPFILE,HNAME,PFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : ISNPROC
@@ -2375,86 +1247,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_X6
-SUBROUTINE FMREADN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-INTEGER, INTENT(INOUT)::KFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-TYPE(FMHEADER) :: TZFMH
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADN0_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- CALL MPI_BCAST(KFIELD,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADN0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADN0_ll
-
SUBROUTINE IO_READ_FIELD_BYNAME_N0(TPFILE,HNAME,KFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -2548,102 +1340,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_N0
-SUBROUTINE FMREADN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-INTEGER,DIMENSION(:),TARGET,INTENT(INOUT)::KFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER,DIMENSION(:),POINTER :: IFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADN1_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
- & ,IRESP)
- END IF
- ELSE
- ALLOCATE(IFIELDP(0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR /= 'XX' .AND. HDIR /='YY') THEN
- ! Broadcast Field
- CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- ELSE
- !Scatter Field
- CALL SCATTER_XXFIELD(HDIR,IFIELDP,KFIELD,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADN1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-IF (GALLOC) DEALLOCATE (IFIELDP)
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADN1_ll
-
SUBROUTINE IO_READ_FIELD_BYNAME_N1(TPFILE,HNAME,KFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -2752,134 +1448,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_N1
-SUBROUTINE FMREADN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LPACK,L1D,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-USE MODE_SCATTER_ll
-USE MODE_ALLOCBUFFER_ll
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-INTEGER, DIMENSION(:,:),TARGET,INTENT(INOUT)::KFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
-LOGICAL :: GALLOC
-TYPE(FMHEADER) :: TZFMH
-INTEGER :: IHEXTOT
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADN2_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-GALLOC = .FALSE.
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-IHEXTOT = 2*JPHEXT+1
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
-! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
- END IF
- KFIELD(:,:)=SPREAD(SPREAD(KFIELD(JPHEXT+1,JPHEXT+1),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
-! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSE IF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
- END IF
- KFIELD(:,:)=SPREAD(KFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,KFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
- END IF
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELDP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP&
- & ,TZFMH,IRESP)
- END IF
- ELSE
- ALLOCATE(IFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- ! XX or YY Scatter Field
- CALL SCATTER_XXFIELD(HDIR,IFIELDP,KFIELD,TZFD%OWNER,TZFD&
- & %COMM)
- ELSE IF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- ! 2D compact case
- CALL SCATTER_XXFIELD('XX',IFIELDP(:,1),KFIELD(:,JPHEXT+1),TZFD%OWNER,TZFD%COMM)
- KFIELD(:,:) = SPREAD(KFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- ! XY Scatter Field
- CALL SCATTER_XYFIELD(IFIELDP,KFIELD,TZFD%OWNER,TZFD%COMM)
- END IF
- ELSE
- ! Broadcast Field
- IF (ISP == TZFD%OWNER) KFIELD = IFIELDP
- CALL MPI_BCAST(KFIELD,SIZE(KFIELD),MPI_INTEGER,TZFD%OWNER-1&
- & ,TZFD%COMM,IERR)
- END IF
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADN2_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-!
-IF (GALLOC) DEALLOCATE (IFIELDP)
-KRESP = IRESP
-RETURN
-!------------------------------------------------------------------
-END SUBROUTINE FMREADN2_ll
-
-
SUBROUTINE IO_READ_FIELD_BYNAME_N2(TPFILE,HNAME,KFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : ISNPROC
@@ -3020,92 +1588,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_N2
-SUBROUTINE FMREADL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
-LOGICAL, INTENT(INOUT)::OFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER :: IFIELD
-TYPE(FMHEADER) :: TZFMH
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADL0_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- CALL MPI_BCAST(IFIELD,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,&
- & IERR)
- END IF
- IF (IFIELD==1) THEN
- OFIELD=.TRUE.
- ELSE
- OFIELD=.FALSE.
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADL0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADL0_ll
-
SUBROUTINE IO_READ_FIELD_BYNAME_L0(TPFILE,HNAME,OFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -3199,96 +1681,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_L0
-SUBROUTINE FMREADL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-LOGICAL, DIMENSION(:), INTENT(INOUT)::OFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
-TYPE(FMHEADER) :: TZFMH
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADL1_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH&
- & ,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,IFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH&
- & ,IRESP)
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- CALL MPI_BCAST(IFIELD,SIZE(IFIELD),MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- END IF
- WHERE (IFIELD==1)
- OFIELD=.TRUE.
- ELSEWHERE
- OFIELD=.FALSE.
- END WHERE
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADL1_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADL1_ll
-
SUBROUTINE IO_READ_FIELD_BYNAME_L1(TPFILE,HNAME,OFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -3382,108 +1774,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_L1
-SUBROUTINE FMREADC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIREAD
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-CHARACTER(LEN=*), INTENT(INOUT)::HFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER :: JLOOP
-INTEGER, DIMENSION(LEN(HFIELD)) :: IFIELD
-CHARACTER(LEN(HFIELD)) :: YFIELD
-INTEGER :: ILENG
-TYPE(FMHEADER) :: TZFMH
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADC0_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-ILENG=LEN(HFIELD)
-!
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,YFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! parallel execution
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,YFIELD,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- IF (LIOCDF4 .AND. .NOT. LLFIREAD) THEN
- ! NetCDF
- CALL MPI_BCAST(YFIELD,ILENG,MPI_CHARACTER,TZFD%OWNER-1,TZFD%COMM,&
- &IERR)
- ELSE
- ! LFI
- CALL MPI_BCAST(IFIELD,ILENG,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,&
- & IERR)
- END IF
- END IF ! parallel execution
- !
- IF (LIOCDF4 .AND. .NOT. LLFIREAD) THEN
- ! NetCDF
- HFIELD = YFIELD
- ELSE
- ! LFI Case
- DO JLOOP=1,ILENG
- HFIELD(JLOOP:JLOOP)=ACHAR(IFIELD(JLOOP))
- END DO
- END IF
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADC0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADC0_ll
-
SUBROUTINE IO_READ_FIELD_BYNAME_C0(TPFILE,HNAME,HFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -3577,104 +1867,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_C0
-SUBROUTINE FMREADT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_IO_ll, ONLY : ISP,GSMONOPROC
-USE MODD_TYPE_DATE
-USE MODD_FM
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-!
-!* 0.1 Declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
-CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
-TYPE (DATE_TIME), INTENT(INOUT)::TFIELD ! array containing the data field
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!
-!* 0.2 Declarations of local variables
-!
-!-------------------------------------------------------------------------------
-
-
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-INTEGER,DIMENSION(3) :: ITDATE
-REAL :: ZTIME
-TYPE(FMHEADER) :: TZFMH
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREADT0_ll','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-IRESP = 0
-
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TDATE',ITDATE,TZFMH,IRESP)
- CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TIME',ZTIME,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
- & ,TZFMH,IRESP)
- CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,ZTIME&
- & ,TZFMH,IRESP)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TDATE',ITDATE,TZFMH,IRESP)
- CALL NCREAD(TZFD%CDF%NCID,TRIM(HRECFM)//'%TIME',ZTIME,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
- & ,TZFMH,IRESP)
- CALL FM_READ_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,ZTIME&
- & ,TZFMH,IRESP)
-
- END IF
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- ! Last header is significant
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- CALL MPI_BCAST(ITDATE,3,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- CALL MPI_BCAST(ZTIME,1,MPI_FLOAT,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- TFIELD%TDATE = DATE(ITDATE(1),ITDATE(2),ITDATE(3))
- TFIELD%TIME = ZTIME
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREADT0_ll",HFILEM,HFIPRI,HRECFM,HDIR,IRESP)
-ENDIF
-KRESP = IRESP
-RETURN
-
-END SUBROUTINE FMREADT0_ll
-
SUBROUTINE IO_READ_FIELD_BYNAME_T0(TPFILE,HNAME,TPDATA,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -3776,223 +1968,6 @@ IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_BYFIELD_T0
-SUBROUTINE FMREAD_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
- & KGRID,KLENCH,HCOMMENT,KRESP)
-USE MODD_FM
-USE MODD_IO_ll, ONLY : ISP,ISNPROC,GSMONOPROC,LPACK,L2D
-USE MODD_PARAMETERS_ll,ONLY : JPHEXT
-USE MODE_DISTRIB_LB
-USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
-USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-!JUANZ
-USE MODD_TIMEZ, ONLY : TIMEZ
-USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
-!JUANZ
-USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
-
-CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
-CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
-CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints
-CHARACTER(LEN=*), INTENT(IN) ::HLBTYPE ! 'LBX','LBXU','LBY' or 'LBYV'
-REAL, DIMENSION(:,:,:),TARGET, INTENT(INOUT)::PLB ! array containing the LB field
-INTEGER, INTENT(IN) :: KRIM ! size of the LB area
-INTEGER, INTENT(IN) :: KL3D ! size of the LB array in FM
-INTEGER, INTENT(INOUT)::KGRID ! C-grid indicator (u,v,w,T)
-INTEGER, INTENT(INOUT)::KLENCH ! length of comment string
-CHARACTER(LEN=*), INTENT(INOUT)::HCOMMENT ! comment string
-INTEGER, INTENT(INOUT)::KRESP ! return-code
-!
-!* 0.2 Declarations of local variables
-!
-CHARACTER(LEN=JPFINL) :: YFNLFI
-INTEGER :: IERR
-TYPE(FD_ll), POINTER :: TZFD
-INTEGER :: IRESP
-REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
-REAL,DIMENSION(:,:,:), POINTER :: TX3DP
-TYPE(FMHEADER) :: TZFMH
-INTEGER :: IIMAX_ll,IJMAX_ll
-INTEGER :: IIB,IIE,IJB,IJE
-INTEGER :: JI
-INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
-INTEGER, ALLOCATABLE,DIMENSION(:,:) :: STATUSES
-!JUANZIO
-!JUAN INTEGER,SAVE,DIMENSION(100000) :: REQ_TAB
-INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
-INTEGER :: NB_REQ,IKU
-TYPE TX_3DP
-REAL,DIMENSION(:,:,:), POINTER :: X
-END TYPE
-TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
-REAL*8,DIMENSION(2) :: T0,T1,T2,T3
-REAL*8,DIMENSION(2) :: T11,T22
-!JUANZIO
-INTEGER :: IHEXTOT
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FMREAD_LB','reading '//TRIM(HRECFM))
-!
-!* 1.1 THE NAME OF LFIFM
-!
-CALL SECOND_MNH2(T11)
-IRESP = 0
-YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
-!------------------------------------------------------------------
-IHEXTOT = 2*JPHEXT+1
-TZFD=>GETFD(YFNLFI)
-IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
- ALLOCATE(Z3D(KL3D,SIZE(PLB,2),SIZE(PLB,3)))
- Z3D = 0.0
- IF (LPACK .AND. L2D) THEN
- TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,TX3DP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
- END IF
- Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
- END IF
- END IF
- PLB(1:KRIM+JPHEXT,:,:) = Z3D(1:KRIM+JPHEXT,:,:)
- PLB(KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:,:) = Z3D(KL3D-KRIM-JPHEXT+1:KL3D,:,:)
- ELSE !(HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV')
- ALLOCATE(Z3D(SIZE(PLB,1),KL3D,SIZE(PLB,3)))
- Z3D = 0.0
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
- END IF
- PLB(:,1:KRIM+JPHEXT,:) = Z3D(:,1:KRIM+JPHEXT,:)
- PLB(:,KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:) = Z3D(:,KL3D-KRIM-JPHEXT+1:KL3D,:)
- END IF
- IF (IRESP /= 0) GOTO 1000
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- CALL SECOND_MNH2(T0)
- CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
- IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
- ALLOCATE(Z3D(KL3D,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
- Z3D = 0.0
- IF (LPACK .AND. L2D) THEN
- TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,TX3DP,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
- END IF
- Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
- ELSE
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
- END IF
- END IF
- ! erase gap in LB field
- Z3D(KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:,:) = Z3D(KL3D-KRIM-JPHEXT+1:KL3D,:,:)
- ELSE !(HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV')
- ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,KL3D,SIZE(PLB,3)))
- Z3D = 0.0
- IF (ASSOCIATED(TZFD%CDF)) THEN
- CALL NCREAD(TZFD%CDF%NCID,HRECFM,Z3D,TZFMH,IRESP)
- ELSE
- CALL FM_READ_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(Z3D),Z3D,TZFMH,IRESP)
- END IF
- ! erase gap in LB field
- Z3D(:,KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:) = Z3D(:,KL3D-KRIM-JPHEXT+1:KL3D,:)
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READLB_READ=TIMEZ%T_READLB_READ + T1 - T0
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- IF (IRESP /= 0) GOTO 1000
- !
- CALL BCAST_HEADER(TZFD,TZFMH)
- !
- NB_REQ=0
- ALLOCATE(REQ_TAB(ISNPROC-1))
- !REQ_TAB=MPI_REQUEST_NULL
- IF (ISP == TZFD%OWNER) THEN
- CALL SECOND_MNH2(T1)
- !ALLOCATE(REQ_TAB(ISNPROC-1))
- !REQ_TAB=MPI_REQUEST_NULL
- ALLOCATE(T_TX3DP(ISNPROC-1))
- IKU = SIZE(Z3D,3)
- DO JI = 1,ISNPROC
- CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','READ',KRIM,IIB,IIE,IJB,IJE)
- IF (IIB /= 0) THEN
- TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
- IF (ISP /= JI) THEN
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
- T_TX3DP(NB_REQ)%X=Z3D(IIB:IIE,IJB:IJE,:)
- CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,IERR)
- ELSE
- CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
- PLB(IIB:IIE,IJB:IJE,:) = TX3DP(:,:,:)
- END IF
- END IF
- END DO
- CALL SECOND_MNH2(T2)
- TIMEZ%T_READLB_SEND=TIMEZ%T_READLB_SEND + T2 - T1
- IF (NB_REQ .GT.0 ) THEN
- !ALLOCATE(STATUSES(MPI_STATUS_SIZE,NB_REQ))
- !CALL MPI_WAITALL(NB_REQ,REQ_TAB,STATUSES,IERR)
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- !DEALLOCATE(STATUSES)
- DO JI=1,NB_REQ ; DEALLOCATE(T_TX3DP(JI)%X) ; ENDDO
- END IF
- DEALLOCATE(T_TX3DP)
- !DEALLOCATE(REQ_TAB)
- CALL SECOND_MNH2(T3)
- TIMEZ%T_READLB_WAIT=TIMEZ%T_READLB_WAIT + T3 - T2
- ELSE
- CALL SECOND_MNH2(T0)
- !ALLOCATE(REQ_TAB(1))
- !REQ_TAB=MPI_REQUEST_NULL
- CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
- IF (IIB /= 0) THEN
- TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,STATUS,IERR)
- !NB_REQ = NB_REQ + 1
- !CALL MPI_IRECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
- !IF (NB_REQ .GT.0 ) CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READLB_RECV=TIMEZ%T_READLB_RECV + T1 - T0
- END IF
- DEALLOCATE(REQ_TAB)
- END IF !(GSMONOPROC)
- KGRID = TZFMH%GRID
- KLENCH = TZFMH%COMLEN
- HCOMMENT = TZFMH%COMMENT(1:TZFMH%COMLEN)
-ELSE
- IRESP = -61
-END IF
-!----------------------------------------------------------------
-1000 CONTINUE
-!! Error handler
-IF (IRESP.NE.0) THEN
- CALL FM_READ_ERR("FMREAD_LB",HFILEM,HFIPRI,HRECFM,HLBTYPE,IRESP)
-ENDIF
-!
-IF (ALLOCATED(Z3D)) DEALLOCATE (Z3D)
-KRESP = IRESP
-!
-!CALL MPI_BARRIER(TZFD%COMM,IERR)
-CALL SECOND_MNH2(T22)
-TIMEZ%T_READLB_ALL=TIMEZ%T_READLB_ALL + T22 - T11
-END SUBROUTINE FMREAD_LB
-
SUBROUTINE IO_READ_FIELD_BYNAME_LB(TPFILE,HNAME,KL3D,KRIM,PLB,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -4017,7 +1992,6 @@ END SUBROUTINE IO_READ_FIELD_BYNAME_LB
SUBROUTINE IO_READ_FIELD_BYFIELD_LB(TPFILE,TPFIELD,KL3D,KRIM,PLB,KRESP)
!
-USE MODD_FM
USE MODD_IO_ll, ONLY : ISP,ISNPROC,GSMONOPROC,LPACK,L2D
USE MODD_PARAMETERS_ll,ONLY : JPHEXT
USE MODD_TIMEZ, ONLY : TIMEZ
diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
index e66b259cd..3d4808a06 100644
--- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90
+++ b/src/LIB/SURCOUCHE/src/fmreadwrit.f90
@@ -11,234 +11,6 @@
! $Date$
!-----------------------------------------------------------------
!-----------------------------------------------------------------
-
-MODULE MODD_FM
-USE MODE_FIELD, ONLY : TFIELDDATA
-IMPLICIT NONE
-
-INTEGER, PARAMETER :: JPXKRK = 100
-INTEGER, PARAMETER :: JPXFIE = 1.5E8
-
-TYPE FMHEADER
- INTEGER :: GRID
- INTEGER :: COMLEN
- CHARACTER(LEN=JPXKRK) :: COMMENT
-END TYPE FMHEADER
-
-END MODULE MODD_FM
-
-SUBROUTINE FM_READ_ll(KFLU,HRECFM,OREAL,KLENG,KFIELD,TPFMH,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
-USE MODE_MSG
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-!
-INTEGER, INTENT(IN) :: KFLU ! Fortran Logical Unit
-CHARACTER(LEN=*), INTENT(IN) :: HRECFM ! name of the desired article
-LOGICAL, INTENT(IN) :: OREAL ! TRUE IF TRANSMITTED KFIELD IS REAL
-INTEGER, INTENT(IN) :: KLENG ! length of the data field
-INTEGER,DIMENSION(KLENG),INTENT(OUT):: KFIELD ! array containing the data field
-TYPE(FMHEADER), INTENT(OUT):: TPFMH ! FM-File Header
-INTEGER, INTENT(OUT):: KRESP ! return-code if problems occured
-!
-!* 0.2 Declarations of local variables
-!
-!JUAN
-INTEGER(KIND=LFI_INT) :: IRESP,ILENGA,IPOSEX,ITOTAL,INUMBR
-INTEGER :: J,IROW
-!JUAN
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE::IWORK
-INTEGER,DIMENSION(1:JPXKRK) ::ICOMMENT
-!
-!* 0.3 Taskcommon for logical units
-!
-!
-!------------------------------------------------------------------
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FM_READ_ll','reading '//TRIM(HRECFM))
-
-!
-!* 1.2 WE LOOK FOR THE FILE'S LOGICAL UNIT
-!
-
-INUMBR = KFLU
-
-!
-!* 2.a LET'S GET SOME INFORMATION ON THE DESIRED ARTICLE
-!
-CALL LFINFO(IRESP,INUMBR,HRECFM,ILENGA,IPOSEX)
-IF (IRESP.NE.0) THEN
- GOTO 1000
-ELSEIF (ILENGA.EQ.0) THEN
- IRESP=-47
- GOTO 1000
-ELSEIF (ILENGA.GT.JPXFIE) THEN
- IRESP=-48
- GOTO 1000
-ENDIF
-
-!
-!* 2.b UNFORMATTED DIRECT ACCESS READ OPERATION
-!
-ITOTAL=ILENGA
-IF ( NZ_VERB .GE. 5 ) print *," fmreadwrit.f90:: FM_READ_ll ILENGA=",ILENGA," HRECFM=",HRECFM
-ALLOCATE(IWORK(ITOTAL))
-
-CALL LFILEC(IRESP,INUMBR,HRECFM,IWORK,ITOTAL)
-IF (IRESP.NE.0) GOTO 1000
-!
-!* 2.c THE GRID INDICATOR AND THE COMMENT STRING
-!* ARE SEPARATED FROM THE DATA
-!
-TPFMH%GRID = IWORK(1)
-TPFMH%COMLEN = IWORK(2)
-
-IROW=KLENG+TPFMH%COMLEN+2
-IF (ITOTAL.NE.IROW) THEN
- PRINT *,'KLENG =',KLENG
- PRINT *,'diff = ',ITOTAL-(TPFMH%COMLEN+2)
- IRESP=-63
- GOTO 1000
-ENDIF
-
-SELECT CASE (TPFMH%COMLEN)
-CASE(:-1)
- IRESP=-58
- GOTO 1000
-CASE(0)
- IRESP = 0
-CASE(1:JPXKRK)
- ICOMMENT(1:TPFMH%COMLEN)=IWORK(3:TPFMH%COMLEN+2)
- DO J=1,TPFMH%COMLEN
- TPFMH%COMMENT(J:J)=CHAR(ICOMMENT(J))
- ENDDO
-CASE(JPXKRK+1:)
- IRESP=-56
- GOTO 1000
-END SELECT
-
-IF (OREAL) THEN
- CALL TRANSFR(KFIELD,IWORK(TPFMH%COMLEN+3),KLENG)
-ELSE
- KFIELD(1:KLENG) = IWORK(TPFMH%COMLEN+3:ITOTAL)
-END IF
-!
-! this is a pure binary field: no uncompressing of any kind
-!
-!* 3. MESSAGE PRINTING WHATEVER THE ISSUE WAS
-!
-1000 CONTINUE
-
-KRESP=IRESP
-
-IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
-
-RETURN
-END SUBROUTINE FM_READ_ll
-
-SUBROUTINE FM_WRIT_ll(KFLU,HRECFM,OREAL,KLENG,KFIELD,TPFMH,KRESP)
-
-USE MODD_FM
-USE MODE_MSG
-
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-!
-INTEGER, INTENT(IN) :: KFLU ! Fortran Logical Unit
-CHARACTER(LEN=*), INTENT(IN) :: HRECFM ! name of the article to be written
-LOGICAL, INTENT(IN) :: OREAL ! TRUE IF TRANSMITTED KFIELD IS REAL
-INTEGER, INTENT(IN) :: KLENG ! length of the data field
-INTEGER,DIMENSION(KLENG),INTENT(IN) :: KFIELD ! array containing the data field
-TYPE(FMHEADER), INTENT(IN) :: TPFMH ! FM-File Header
-INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
-!
-!* 0.2 Declarations of local variables
-!
-!JUAN
-INTEGER(kind=LFI_INT) :: IRESP,ITOTAL,INUMBR
-INTEGER :: J
-!JUAN
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE::IWORK
-INTEGER,DIMENSION(1:JPXKRK) ::ICOMMENT
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','FM_WRIT_ll','writing '//TRIM(HRECFM))
-
-!
-!* 1.2 WE LOOK FOR THE FILE'S LOGICAL UNIT
-!
-
-INUMBR = KFLU
-
-!
-!* 2. GRID INDICATOR, COMMENT AND DATA ARE PUT TOGETHER
-!
-
-IF (KLENG.LE.0) THEN
- IRESP=-40
- GOTO 1000
-ELSEIF (KLENG.GT.JPXFIE) THEN
- IRESP=-43
- GOTO 1000
-ELSEIF ((TPFMH%GRID.LT.0).OR.(TPFMH%GRID.GT.8)) THEN
- IRESP=-46
- GOTO 1000
-ENDIF
-
-ITOTAL=KLENG+1+TPFMH%COMLEN+1
-ALLOCATE(IWORK(ITOTAL))
-
-IWORK(1)=TPFMH%GRID
-
-SELECT CASE (TPFMH%COMLEN)
-CASE(:-1)
- IRESP=-55
- GOTO 1000
-CASE(0)
- IWORK(2)=TPFMH%COMLEN
-CASE(1:JPXKRK)
- DO J=1,TPFMH%COMLEN
- ICOMMENT(J)=ICHAR(TPFMH%COMMENT(J:J))
- ENDDO
- IWORK(2)=TPFMH%COMLEN
- IWORK(3:TPFMH%COMLEN+2)=ICOMMENT(1:TPFMH%COMLEN)
-CASE(JPXKRK+1:)
- IRESP=-57
- GOTO 1000
-END SELECT
-
-IF (OREAL) THEN
- CALL TRANSFW(IWORK(TPFMH%COMLEN+3),KFIELD,KLENG)
-ELSE
- IWORK(TPFMH%COMLEN+3:ITOTAL)=KFIELD(1:KLENG)
-END IF
-
-!
-! no compressing of any kind: the data is pure binary
-!
-!* 3. UNFORMATTED, DIRECT ACCESS WRITE OPERATION
-!
-CALL LFIECR(IRESP,INUMBR,HRECFM,IWORK,ITOTAL)
-
-
-!
-!* 4. MESSAGE PRINTING WHATEVER THE ISSUE WAS
-!
-1000 CONTINUE
-
-KRESP=IRESP
-
-IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
-
-RETURN
-END SUBROUTINE FM_WRIT_ll
-
SUBROUTINE TRANSFR(KDEST,KSOURCE,KSIZE)
IMPLICIT NONE
INTEGER :: KSIZE
@@ -262,7 +34,6 @@ END SUBROUTINE TRANSFW
MODULE MODE_READWRITE_LFI
!
-USE MODD_FM
USE MODD_IO_ll
USE MODE_FIELD, ONLY : TFIELDDATA
USE MODE_MSG
@@ -271,6 +42,9 @@ IMPLICIT NONE
!
PRIVATE
!
+INTEGER, PARAMETER :: JPXKRK = 100
+INTEGER, PARAMETER :: JPXFIE = 1.5E8
+!
INTERFACE IO_READ_FIELD_LFI
MODULE PROCEDURE IO_READ_FIELD_LFI_X0, IO_READ_FIELD_LFI_X1, &
IO_READ_FIELD_LFI_X2, IO_READ_FIELD_LFI_X3, &
@@ -300,8 +74,6 @@ PUBLIC IO_READ_FIELD_LFI,IO_WRITE_FIELD_LFI
CONTAINS
!
SUBROUTINE IO_READ_FIELD_LFI_X0(TPFILE,TPFIELD,PFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -336,8 +108,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_X0
!
!
SUBROUTINE IO_READ_FIELD_LFI_X1(TPFILE,TPFIELD,PFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -372,8 +142,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_X1
!
!
SUBROUTINE IO_READ_FIELD_LFI_X2(TPFILE,TPFIELD,PFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -408,8 +176,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_X2
!
!
SUBROUTINE IO_READ_FIELD_LFI_X3(TPFILE,TPFIELD,PFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -444,8 +210,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_X3
!
!
SUBROUTINE IO_READ_FIELD_LFI_X4(TPFILE,TPFIELD,PFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -480,8 +244,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_X4
!
!
SUBROUTINE IO_READ_FIELD_LFI_X5(TPFILE,TPFIELD,PFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -516,8 +278,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_X5
!
!
SUBROUTINE IO_READ_FIELD_LFI_X6(TPFILE,TPFIELD,PFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -552,8 +312,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_X6
!
!
SUBROUTINE IO_READ_FIELD_LFI_N0(TPFILE,TPFIELD,KFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -588,8 +346,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_N0
!
!
SUBROUTINE IO_READ_FIELD_LFI_N1(TPFILE,TPFIELD,KFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -624,8 +380,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_N1
!
!
SUBROUTINE IO_READ_FIELD_LFI_N2(TPFILE,TPFIELD,KFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -660,8 +414,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_N2
!
!
SUBROUTINE IO_READ_FIELD_LFI_L0(TPFILE,TPFIELD,OFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -709,8 +461,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_L0
!
!
SUBROUTINE IO_READ_FIELD_LFI_L1(TPFILE,TPFIELD,OFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -763,8 +513,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_L1
!
!
SUBROUTINE IO_READ_FIELD_LFI_C0(TPFILE,TPFIELD,HFIELD,KRESP)
-USE MODD_FM
-USE MODD_CONFZ, ONLY : NZ_VERB
USE MODE_MSG
!
IMPLICIT NONE
@@ -804,8 +552,6 @@ END SUBROUTINE IO_READ_FIELD_LFI_C0
!
SUBROUTINE IO_READ_FIELD_LFI_T0(TPFILE,TPFIELD,TPDATA,KRESP)
!
-USE MODD_CONFZ, ONLY : NZ_VERB
-USE MODD_FM
USE MODE_MSG
USE MODD_TYPE_DATE
!
diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
index 32e9ede12..be0a98099 100644
--- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
+++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90
@@ -207,57 +207,11 @@ MODULE MODE_FMWRIT
MODULE PROCEDURE IO_WRITE_FIELD_BYNAME_LB, IO_WRITE_FIELD_BYFIELD_LB
END INTERFACE
- INTERFACE FMWRIT
- MODULE PROCEDURE FMWRITX0_ll,FMWRITX1_ll,FMWRITX2_ll,FMWRITX3_ll,&
- & FMWRITX4_ll,FMWRITX5_ll,FMWRITX6_ll,&
- & FMWRITN0_ll,FMWRITN1_ll,FMWRITN2_ll,&
- & FMWRITL0_ll,FMWRITL1_ll,FMWRITC0_ll,&
- & FMWRITC1_ll,FMWRITT0_ll
- END INTERFACE
-
- INTERFACE FMWRITBOX
- MODULE PROCEDURE FMWRITBOXX2_ll,FMWRITBOXX3_ll,FMWRITBOXX4_ll,&
- & FMWRITBOXX5_ll,FMWRITBOXX6_ll
- END INTERFACE
-
- PUBLIC FMWRIT_LB,FMWRITBOX,FMWRIT,FMWRITX0_ll,FMWRITX1_ll,FMWRITX2_ll,FMWRITX3_ll,&
- & FMWRITX4_ll,FMWRITX5_ll,FMWRITX6_ll,FMWRITN0_ll,FMWRITN1_ll,FMWRITN2_ll,&
- & FMWRITL0_ll,FMWRITL1_ll,FMWRITC0_ll,FMWRITC1_ll,FMWRITT0_ll,FMWRITBOXX2_ll,&
- & FMWRITBOXX3_ll,FMWRITBOXX4_ll,FMWRITBOXX5_ll,FMWRITBOXX6_ll
PUBLIC IO_WRITE_FIELD, IO_WRITE_FIELD_BOX, IO_WRITE_FIELD_LB
PUBLIC IO_WRITE_HEADER
- !INCLUDE 'mpif.h'
-
CONTAINS
- SUBROUTINE FM_WRIT_ERR(HFUNC,HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,KRESP)
- USE MODE_FM, ONLY : FMLOOK_ll
-
- CHARACTER(LEN=*) :: HFUNC
- CHARACTER(LEN=*) :: HFILEM
- CHARACTER(LEN=*) :: HFIPRI
- CHARACTER(LEN=*) :: HRECFM
- CHARACTER(LEN=*) :: HDIR
- INTEGER :: KGRID
- INTEGER :: KLENCH
- INTEGER :: KRESP
-
- INTEGER :: ILUPRI
- INTEGER :: IRESP
-
- CALL FMLOOK_ll(HFIPRI,HFIPRI,ILUPRI,IRESP)
- WRITE (ILUPRI,*) ' exit from ',HFUNC,' with RESP:',KRESP
- WRITE (ILUPRI,*) ' | HFILEM = ',HFILEM
- WRITE (ILUPRI,*) ' | HRECFM = ',HRECFM
- WRITE (ILUPRI,*) ' | HDIR = ',HDIR
- WRITE (ILUPRI,*) ' | KGRID = ',KGRID
- WRITE (ILUPRI,*) ' | KLENCH = ',KLENCH
-
- END SUBROUTINE FM_WRIT_ERR
-
-
SUBROUTINE FIELD_METADATA_CHECK(TPFIELD,KTYPE,KDIMS,HCALLER)
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD ! Field to check
INTEGER, INTENT(IN) :: KTYPE ! Expected datatype
@@ -346,99 +300,6 @@ CONTAINS
!
END SUBROUTINE IO_WRITE_HEADER
- SUBROUTINE FMWRITX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
-!
-! Modification
-! J.Escobar 15/04/2014 : add write to all Z files for all FMWRITX0_ll variables
-! J.Escobar 23/06/2014 : bug , replace .FALSE. to .TRUE. = OREAL type transmetted to FM_WRIT_ll
-!
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL, INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- !----------------------------------------------------------------
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- !JUANZIO
- INTEGER :: IK_FILE,IK_rank
- CHARACTER(len=5) :: YK_FILE
- CHARACTER(len=128) :: YFILE_IOZ
- TYPE(FD_ll), POINTER :: TZFD_IOZ
- !JUANZIO
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITX0_ll','writing '//TRIM(HRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article 0 ' , HRECFM
- !
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF ! multiprocessor execution
- IF (TZFD%nb_procio.gt.1) THEN
- ! write the data in all Z files
- DO IK_FILE=1,TZFD%nb_procio
- write(YK_FILE ,'(".Z",i3.3)') IK_FILE
- YFILE_IOZ = TRIM(HFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- IK_RANK = TZFD_IOZ%OWNER
- IF ( ISP == IK_RANK ) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.TRUE.,1,PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
- END IF
- END DO
- ENDIF
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITX0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- KRESP = IRESP
- END SUBROUTINE FMWRITX0_ll
SUBROUTINE IO_WRITE_FIELD_BYNAME_X0(TPFILE,HNAME,PFIELD,KRESP)
!
@@ -466,6 +327,7 @@ CONTAINS
!
END SUBROUTINE IO_WRITE_FIELD_BYNAME_X0
+
SUBROUTINE IO_WRITE_FIELD_BYFIELD_X0(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODD_IO_ll
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
@@ -557,89 +419,6 @@ CONTAINS
IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X0
- SUBROUTINE FMWRITX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- !----------------------------------------------------------------
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- REAL,DIMENSION(:),POINTER :: ZFIELDP
- LOGICAL :: GALLOC
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITX1_ll','writing '//TRIM(HRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITX1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITX1_ll
SUBROUTINE IO_WRITE_FIELD_BYNAME_X1(TPFILE,HNAME,PFIELD,KRESP)
!
@@ -667,6 +446,7 @@ CONTAINS
!
END SUBROUTINE IO_WRITE_FIELD_BYNAME_X1
+
SUBROUTINE IO_WRITE_FIELD_BYFIELD_X1(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODD_IO_ll
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
@@ -768,182 +548,6 @@ CONTAINS
IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X1
- SUBROUTINE FMWRITX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- !JUANZ
- USE MODD_TIMEZ, ONLY : TIMEZ
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
- !JUANZ
-#ifdef MNH_GA
- !JUAN_IOGA
- USE MODE_GA
-#endif
- !
- IMPLICIT NONE
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
- !
- !JUANZ
- REAL*8,DIMENSION(2) :: T0,T1,T2
- REAL*8,DIMENSION(2) :: T11,T22
- !JUANZ
-#ifdef MNH_GA
- REAL,DIMENSION(:,:),POINTER :: ZFIELDP_GA , ZFIELD_GA
- REAL :: ERROR
- INTEGER :: JI
-#endif
- INTEGER :: IHEXTOT
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITX2_ll','writing '//TRIM(HRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
- !
- CALL SECOND_MNH2(T11)
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !------------------------------------------------------------------
- IHEXTOT = 2*JPHEXT+1
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- ELSE
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
- END IF
- ELSE ! multiprocessor execution
- CALL SECOND_MNH2(T0)
- IF (ISP == TZFD%OWNER) THEN
- ! I/O processor case
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1),ZFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
- ELSE
-#ifdef MNH_GA
- !
- ! init/create the ga , dim3 = 1
- !
- CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),1,HRECFM,"WRITE")
- !
- ! copy columun data to global arrays g_a
- !
- ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
- ZFIELD_GA = PFIELD
- call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L) , ld_col)
-!!$ print*," nga_put =",HRECFM,g_a," lo_col=",lo_col," hi_col=",hi_col,ZFIELD_GA(NIXO_L,NIYO_L), &
-!!$ " NIXO_L=",NIXO_L,"NIYO_L=",NIYO_L," ld_col=",ld_col," ISP=",ISP
- call ga_sync
- DEALLOCATE (ZFIELD_GA)
- IF (ISP == TZFD%OWNER) THEN
- !
- ! this proc get the Z slide to write
- !
- lo_zplan(JPIZ) = 1
- hi_zplan(JPIZ) = 1
-!!$ ALLOCATE (ZFIELDP_GA(IIU_ll,IJU_ll))
- call nga_get(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
-!!$ print*,"nga_get=",HRECFM,g_a," lo_zplan=",lo_zplan," hi_zplan=",hi_zplan &
-!!$ ,ZFIELDP(1,1)," ld_zplan=",ld_zplan
- END IF
-!!$ call ga_sync
-#else
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
-!!$ IF (ISP == TZFD%OWNER) THEN
-!!$ print*,HRECFM, "ERR=", MAXVAL (ZFIELDP_GA - ZFIELDP)
-!!$ DO JI=1,IJU_ll
-!!$ !print*,HRECFM, "ERR=", ZFIELDP_GA(:,JI) - ZFIELDP(:,JI)
-!!$ print*,HRECFM, "WX2::GA =", ZFIELDP_GA(:,JI)
-!!$ print*,HRECFM, "WX2::MNH=", ZFIELDP(:,JI)
-!!$ END DO
-!!$ END IF
-#endif
- END IF
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- END IF
-#ifdef MNH_GA
-!!$ IF (ISP .EQ. 1 ) THEN
-!!$ call ga_print_stats()
-!!$ call ga_summarize(1)
-!!$ ENDIF
- call ga_sync
-!!$ gstatus_ga = ga_destroy(g_a)
-#endif
- CALL SECOND_MNH2(T2)
- TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITX2_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
- CALL SECOND_MNH2(T22)
- TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
- END SUBROUTINE FMWRITX2_ll
SUBROUTINE IO_WRITE_FIELD_BYNAME_X2(TPFILE,HNAME,PFIELD,KRESP)
!
@@ -971,6 +575,7 @@ CONTAINS
!
END SUBROUTINE IO_WRITE_FIELD_BYNAME_X2
+
SUBROUTINE IO_WRITE_FIELD_BYFIELD_X2(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODD_IO_ll
USE MODD_PARAMETERS_ll,ONLY : JPHEXT
@@ -1158,50 +763,72 @@ CONTAINS
TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X2
- SUBROUTINE FMWRITX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- !JUANZ
- USE MODD_IO_ll, ONLY : ISNPROC
- USE MODE_IO_ll, ONLY : io_file,io_rank
- USE MODD_TIMEZ, ONLY : TIMEZ
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
- !JUANZ
-#ifdef MNH_GA
- USE MODE_GA
-#endif
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_X3(TPFILE,HNAME,PFIELD,KRESP)
!
+ USE MODD_IO_ll, ONLY : TFILEDATA
!
!* 0.1 Declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ REAL,DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: ID ! Index of the field
+ INTEGER :: IRESP ! return_code
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X3',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+ !
+ IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ !
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_X3
+
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_X3(TPFILE,TPFIELD,PFIELD,KRESP)
+ USE MODD_IO_ll
+ USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_ALLOCBUFFER_ll
+ USE MODE_GATHER_ll
+ !JUANZ
+ USE MODE_IO_ll, ONLY : io_file,io_rank
+ USE MODD_TIMEZ, ONLY : TIMEZ
+ USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+ !JUANZ
+#ifdef MNH_GA
+ USE MODE_GA
+#endif
+ USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=28) :: YFILEM ! FM-file name
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
+ CHARACTER(LEN=2) :: YDIR ! field form
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ INTEGER :: ISIZEMAX
+ TYPE(FD_ll), POINTER :: TZFD
INTEGER :: IRESP
REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
LOGICAL :: GALLOC
!JUAN
INTEGER :: JK,JKK
- CHARACTER(LEN=LEN(HRECFM)) :: YK,YRECZSLIDE
REAL,DIMENSION(:,:),POINTER :: ZSLIDE_ll,ZSLIDE
INTEGER :: IK_FILE,IK_rank,inb_proc_real,JK_MAX
CHARACTER(len=5) :: YK_FILE
@@ -1228,8 +855,16 @@ CONTAINS
REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
#endif
INTEGER :: IHEXTOT
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ !
+ YFILEM = TPFILE%CNAME
+ YRECFM = TPFIELD%CMNHNAME
+ YDIR = TPFIELD%CDIR
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X3',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITX3_ll','writing '//TRIM(HRECFM))
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,3,'IO_WRITE_FIELD_BYFIELD_X3')
!
!* 1.1 THE NAME OF LFIFM
!
@@ -1237,43 +872,50 @@ CONTAINS
IRESP = 0
GALLOC = .FALSE.
GALLOC_ll = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article 3 ' , HRECFM
+ YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
!
!------------------------------------------------------------------
IHEXTOT = 2*JPHEXT+1
TZFD=>GETFD(YFNLFI)
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC .AND. (TZFD%nb_procio.eq.1) ) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
+ ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,ZFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,ZFIELDP,IRESP)
+ ! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,ZFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,ZFIELDP,IRESP)
ELSE
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,PFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,PFIELD,IRESP)
+ END IF
+ ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR. ( YDIR == '--' ) ) THEN ! multiprocessor execution & 1 proc IO
+#ifndef MNH_INT8
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
+#else
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
+#endif
+ IF (ISIZEMAX==0) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
END IF
- ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR. ( HDIR == '--' ) ) THEN ! multiprocessor execution & 1 proc IO
+
! write 3D field in 1 time = output for graphique
IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
+ CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,YDIR,GALLOC)
ELSE
ALLOCATE(ZFIELDP(0,0,0))
GALLOC = .TRUE.
END IF
!
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
+ IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
+ CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
ELSE
@@ -1282,18 +924,24 @@ CONTAINS
END IF
!
IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- END IF
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,ZFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,ZFIELDP,IRESP)
+ END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
& %COMM,IERR)
!
ELSE ! multiprocessor execution & // IO
+#ifndef MNH_INT8
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
+#else
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
+#endif
+ IF (ISIZEMAX==0) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
!
!JUAN BG Z SLIDE
!
@@ -1303,7 +951,7 @@ CONTAINS
! init/create the ga
!
CALL SECOND_MNH2(T0)
- CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),HRECFM,"WRITE")
+ CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),YRECFM,"WRITE")
!
! copy columun data to global arrays g_a
!
@@ -1311,7 +959,7 @@ CONTAINS
ZFIELD_GA = PFIELD
call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L,1) , ld_col)
DEALLOCATE(ZFIELD_GA)
-!!$ print*," nga_put =",HRECFM,g_a," lo_col=",lo_col," hi_col=",hi_col,PFIELD(NIXO_L,NIYO_L,1) &
+!!$ print*," nga_put =",YRECFM,g_a," lo_col=",lo_col," hi_col=",hi_col,PFIELD(NIXO_L,NIYO_L,1) &
!!$ ," ld_col=",ld_col
call ga_sync
CALL SECOND_MNH2(T1)
@@ -1326,7 +974,7 @@ CONTAINS
!
IK_FILE = io_file(JKK,TZFD%nb_procio)
write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
- YFILE_IOZ = TRIM(HFILEM)//YK_FILE//".lfi"
+ YFILE_IOZ = TRIM(YFILEM)//YK_FILE//".lfi"
TZFD_IOZ => GETFD(YFILE_IOZ)
!
IK_RANK = TZFD_IOZ%OWNER
@@ -1334,15 +982,10 @@ CONTAINS
!
IF (ISP == IK_RANK ) THEN
CALL SECOND_MNH2(T0)
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- WRITE(YK,'(I4.4)') JKK
- YRECZSLIDE = TRIM(HRECFM)//YK
!
IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
DEALLOCATE(ZSLIDE_ll)
- CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
+ CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,YDIR,GALLOC_ll)
END IF
!
! this proc get this JKK slide
@@ -1353,9 +996,8 @@ CONTAINS
CALL SECOND_MNH2(T1)
TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
!
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),&
- &ZSLIDE_ll,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,YRECZSLIDE,HDIR,ZSLIDE_ll,TZFMH,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD_IOZ%FLU,ZSLIDE_ll,IRESP,KVERTLEVEL=JKK)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD_IOZ%CDF,ZSLIDE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
CALL SECOND_MNH2(T2)
TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
END IF
@@ -1394,7 +1036,7 @@ CONTAINS
IF (TZFD%NB_PROCIO .GT. 1 ) THEN
IK_FILE = io_file(JKK,TZFD%nb_procio)
write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
- YFILE_IOZ = TRIM(HFILEM)//YK_FILE//".lfi"
+ YFILE_IOZ = TRIM(YFILEM)//YK_FILE//".lfi"
TZFD_IOZ => GETFD(YFILE_IOZ)
ELSE
TZFD_IOZ => TZFD
@@ -1403,10 +1045,10 @@ CONTAINS
!IK_RANK = 1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
IK_RANK = TZFD_IOZ%OWNER
!
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
+ IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
STOP " XX NON PREVU SUR BG POUR LE MOMENT "
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
+ CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
@@ -1441,7 +1083,7 @@ CONTAINS
IF (TZFD%NB_PROCIO .GT. 1 ) THEN
IK_FILE = io_file(JKK,TZFD%nb_procio)
write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
- YFILE_IOZ = TRIM(HFILEM)//YK_FILE//".lfi"
+ YFILE_IOZ = TRIM(YFILEM)//YK_FILE//".lfi"
TZFD_IOZ => GETFD(YFILE_IOZ)
ELSE
TZFD_IOZ => TZFD
@@ -1455,7 +1097,7 @@ CONTAINS
! I/O proc case
IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
DEALLOCATE(ZSLIDE_ll)
- CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,HDIR,GALLOC_ll)
+ CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,YDIR,GALLOC_ll)
END IF
DO JI=1,ISNPROC
CALL GET_DOMWRITE_ll(JI,'global',IXO,IXE,IYO,IYE)
@@ -1473,14 +1115,8 @@ CONTAINS
CALL SECOND_MNH2(T1)
TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
!JUANIOZ
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- WRITE(YK,'(I4.4)') JKK
- YRECZSLIDE = TRIM(HRECFM)//YK
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,YRECZSLIDE,.TRUE.,SIZE(ZSLIDE_ll),ZSLIDE_ll,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,YRECZSLIDE,HDIR,ZSLIDE_ll,TZFMH,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD_IOZ%FLU,ZSLIDE_ll,IRESP,KVERTLEVEL=JKK)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD_IOZ%CDF,ZSLIDE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
CALL SECOND_MNH2(T2)
TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
END IF
@@ -1508,21 +1144,25 @@ CONTAINS
END IF ! multiprocessor execution
ELSE
IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X3','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITX3_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
+ WRITE(YRESP, '( I6 )') IRESP
+ YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X3',YMSG)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (GALLOC_ll) DEALLOCATE(ZSLIDE_ll)
!IF (Associated(ZSLIDE_ll)) DEALLOCATE(ZSLIDE_ll)
- KRESP = IRESP
+ IF (PRESENT(KRESP)) KRESP = IRESP
IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
CALL SECOND_MNH2(T22)
TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
- END SUBROUTINE FMWRITX3_ll
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X3
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X3(TPFILE,HNAME,PFIELD,KRESP)
+
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_X4(TPFILE,HNAME,PFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : TFILEDATA
!
@@ -1530,7 +1170,7 @@ CONTAINS
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- REAL,DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
+ REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
@@ -1538,7 +1178,7 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X3',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X4',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
@@ -1546,9 +1186,10 @@ CONTAINS
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X3
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_X4
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X3(TPFILE,TPFIELD,PFIELD,KRESP)
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_X4(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODD_IO_ll
USE MODD_PARAMETERS_ll,ONLY : JPHEXT
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
@@ -1559,18 +1200,15 @@ CONTAINS
USE MODD_TIMEZ, ONLY : TIMEZ
USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
!JUANZ
-#ifdef MNH_GA
- USE MODE_GA
-#endif
USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
!
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(:,:,:,:),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
@@ -1582,35 +1220,8 @@ CONTAINS
INTEGER :: ISIZEMAX
TYPE(FD_ll), POINTER :: TZFD
INTEGER :: IRESP
- REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
+ REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
- !JUAN
- INTEGER :: JK,JKK
- REAL,DIMENSION(:,:),POINTER :: ZSLIDE_ll,ZSLIDE
- INTEGER :: IK_FILE,IK_rank,inb_proc_real,JK_MAX
- CHARACTER(len=5) :: YK_FILE
- CHARACTER(len=128) :: YFILE_IOZ
- TYPE(FD_ll), POINTER :: TZFD_IOZ
- INTEGER :: JI,IXO,IXE,IYO,IYE
- REAL,DIMENSION(:,:),POINTER :: TX2DP
- INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
- INTEGER, ALLOCATABLE,DIMENSION(:,:) :: STATUSES
- LOGICAL :: GALLOC_ll
- !JUANZIO
- !INTEGER,SAVE,DIMENSION(100000) :: REQ_TAB
- INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
- INTEGER :: NB_REQ
- TYPE TX_2DP
- REAL,DIMENSION(:,:), POINTER :: X
- END TYPE TX_2DP
- TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
- REAL*8,DIMENSION(2) :: T0,T1,T2
- REAL*8,DIMENSION(2) :: T11,T22
- !JUANZIO
- !JUAN
-#ifdef MNH_GA
- REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
-#endif
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
@@ -1619,54 +1230,47 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X3',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
- !
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,3,'IO_WRITE_FIELD_BYFIELD_X3')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X4',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- !* 1.1 THE NAME OF LFIFM
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,4,'IO_WRITE_FIELD_BYFIELD_X4')
!
- CALL SECOND_MNH2(T11)
IRESP = 0
GALLOC = .FALSE.
- GALLOC_ll = .FALSE.
YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
!
!------------------------------------------------------------------
IHEXTOT = 2*JPHEXT+1
TZFD=>GETFD(YFNLFI)
IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC .AND. (TZFD%nb_procio.eq.1) ) THEN ! sequential execution
+ IF (GSMONOPROC) THEN ! sequential execution
! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,ZFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,ZFIELDP,IRESP)
+ ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:)
! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:)
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:)
IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,ZFIELDP,IRESP)
IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,ZFIELDP,IRESP)
ELSE
IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,PFIELD,IRESP)
IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,PFIELD,IRESP)
END IF
- ELSEIF ( (TZFD%nb_procio .eq. 1 ) .OR. ( YDIR == '--' ) ) THEN ! multiprocessor execution & 1 proc IO
+ ELSE
#ifndef MNH_INT8
CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
#else
CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
#endif
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X4','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
- ! write 3D field in 1 time = output for graphique
IF (ISP == TZFD%OWNER) THEN
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,YDIR,GALLOC)
ELSE
- ALLOCATE(ZFIELDP(0,0,0))
+ ALLOCATE(ZFIELDP(0,0,0,0))
GALLOC = .TRUE.
END IF
!
@@ -1674,7 +1278,7 @@ CONTAINS
CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
+ CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:,:),ZFIELDP(:,1,:,:),TZFD%OWNER,TZFD%COMM)
ELSE
CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
END IF
@@ -1685,342 +1289,24 @@ CONTAINS
IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,ZFIELDP,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- !
- ELSE ! multiprocessor execution & // IO
-#ifndef MNH_INT8
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
-#endif
- IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
- IF (PRESENT(KRESP)) KRESP=0
- RETURN
- END IF
- !
- !JUAN BG Z SLIDE
- !
- !
-#ifdef MNH_GA
- !
- ! init/create the ga
- !
- CALL SECOND_MNH2(T0)
- CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),YRECFM,"WRITE")
- !
- ! copy columun data to global arrays g_a
- !
- ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
- ZFIELD_GA = PFIELD
- call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L,1) , ld_col)
- DEALLOCATE(ZFIELD_GA)
-!!$ print*," nga_put =",YRECFM,g_a," lo_col=",lo_col," hi_col=",hi_col,PFIELD(NIXO_L,NIYO_L,1) &
-!!$ ," ld_col=",ld_col
- call ga_sync
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + T1 - T0
- !
- ! write the data
- !
- ALLOCATE(ZSLIDE_ll(0,0)) ! to avoid bug on test of size
- GALLOC_ll = .TRUE.
- !
- DO JKK=1,IKU_ll
- !
- IK_FILE = io_file(JKK,TZFD%nb_procio)
- write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
- YFILE_IOZ = TRIM(YFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- !
- IK_RANK = TZFD_IOZ%OWNER
- !IK_RANK = 1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
- !
- IF (ISP == IK_RANK ) THEN
- CALL SECOND_MNH2(T0)
- !
- IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
- DEALLOCATE(ZSLIDE_ll)
- CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,YDIR,GALLOC_ll)
- END IF
- !
- ! this proc get this JKK slide
- !
- lo_zplan(JPIZ) = JKK
- hi_zplan(JPIZ) = JKK
- call nga_get(g_a, lo_zplan, hi_zplan,ZSLIDE_ll, ld_zplan)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
- !
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD_IOZ%FLU,ZSLIDE_ll,IRESP,KVERTLEVEL=JKK)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD_IOZ%CDF,ZSLIDE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- CALL SECOND_MNH2(T2)
- TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
- END IF
- END DO
- !call ga_sync
- !
- ! destroy the global array
- !
-!!$ IF (ISP .EQ. 1 ) THEN
-!!$ call ga_print_stats()
-!!$ call ga_summarize(1)
-!!$ ENDIF
- CALL SECOND_MNH2(T0)
- call ga_sync
-!!$ gstatus_ga = ga_destroy(g_a)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_WAIT=TIMEZ%T_WRIT3D_WAIT + T1 - T0
-#else
- !
- ALLOCATE(ZSLIDE_ll(0,0))
- GALLOC_ll = .TRUE.
- inb_proc_real = min(TZFD%nb_procio,ISNPROC)
- Z_SLIDE: DO JK=1,SIZE(PFIELD,3),inb_proc_real
- !
- ! collecte the data
- !
- JK_MAX=min(SIZE(PFIELD,3),JK+inb_proc_real-1)
- !
- NB_REQ=0
- ALLOCATE(REQ_TAB(inb_proc_real))
- ALLOCATE(T_TX2DP(inb_proc_real))
- DO JKK=JK,JK_MAX
- !
- ! get the file & rank to write this level
- !
- IF (TZFD%NB_PROCIO .GT. 1 ) THEN
- IK_FILE = io_file(JKK,TZFD%nb_procio)
- write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
- YFILE_IOZ = TRIM(YFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- ELSE
- TZFD_IOZ => TZFD
- END IF
- !
- !IK_RANK = 1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
- IK_RANK = TZFD_IOZ%OWNER
- !
- IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
- STOP " XX NON PREVU SUR BG POUR LE MOMENT "
- CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (YDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- STOP " L2D NON PREVU SUR BG POUR LE MOMENT "
- CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
- ELSE
- !CALL GATHER_XYFIELD(ZSLIDE,ZSLIDE_ll,TZFD_IOZ%OWNER,TZFD_IOZ%COMM)
- !JUANIOZ
- CALL SECOND_MNH2(T0)
- IF ( ISP /= IK_RANK ) THEN
- ! Other processors
- CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
- IF (IXO /= 0) THEN ! intersection is not empty
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX2DP(NB_REQ)%X(IXO:IXE,IYO:IYE))
- ZSLIDE => PFIELD(:,:,JKK)
- TX2DP=>ZSLIDE(IXO:IXE,IYO:IYE)
- T_TX2DP(NB_REQ)%X=ZSLIDE(IXO:IXE,IYO:IYE)
- CALL MPI_ISEND(T_TX2DP(NB_REQ)%X,SIZE(TX2DP),MPI_FLOAT,IK_RANK-1,99+IK_RANK &
- & ,TZFD_IOZ%COMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MPI_FLOAT,IK_RANK-1,99+IK_RANK,TZFD_IOZ%COMM,IERR)
- END IF
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + T1 - T0
- !JUANIOZ
- END IF
- END IF
- END DO
- !
- ! write the data
- !
- DO JKK=JK,JK_MAX
- IF (TZFD%NB_PROCIO .GT. 1 ) THEN
- IK_FILE = io_file(JKK,TZFD%nb_procio)
- write(YK_FILE ,'(".Z",i3.3)') IK_FILE+1
- YFILE_IOZ = TRIM(YFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- ELSE
- TZFD_IOZ => TZFD
- ENDIF
- IK_RANK = TZFD_IOZ%OWNER
- !IK_RANK = 1 + io_rank(IK_FILE,ISNPROC,TZFD%nb_procio)
- !
- IF (ISP == IK_RANK ) THEN
- !JUANIOZ
- CALL SECOND_MNH2(T0)
- ! I/O proc case
- IF ( SIZE(ZSLIDE_ll) .EQ. 0 ) THEN
- DEALLOCATE(ZSLIDE_ll)
- CALL ALLOCBUFFER_ll(ZSLIDE_ll,ZSLIDE,YDIR,GALLOC_ll)
- END IF
- DO JI=1,ISNPROC
- CALL GET_DOMWRITE_ll(JI,'global',IXO,IXE,IYO,IYE)
- IF (IXO /= 0) THEN ! intersection is not empty
- TX2DP=>ZSLIDE_ll(IXO:IXE,IYO:IYE)
- IF (ISP == JI) THEN
- CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE)
- ZSLIDE => PFIELD(:,:,JKK)
- TX2DP = ZSLIDE(IXO:IXE,IYO:IYE)
- ELSE
- CALL MPI_RECV(TX2DP,SIZE(TX2DP),MPI_FLOAT,JI-1,99+IK_RANK,TZFD_IOZ%COMM,STATUS,IERR)
- END IF
- END IF
- END DO
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
- !JUANIOZ
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD_IOZ%FLU,ZSLIDE_ll,IRESP,KVERTLEVEL=JKK)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD_IOZ%CDF,ZSLIDE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- CALL SECOND_MNH2(T2)
- TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
- END IF
-!!$ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD_IOZ%OWNER-1,TZFD_IOZ%COMM,IERR)
- END DO
- !CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD_IOZ%OWNER-1,TZFD_IOZ%COMM,IERR)
- !CALL MPI_BARRIER(TZFD_IOZ%COMM,IERR)
- !
- CALL SECOND_MNH2(T0)
- IF (NB_REQ .GT.0 ) THEN
- !ALLOCATE(STATUSES(MPI_STATUS_SIZE,NB_REQ))
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- !CALL MPI_WAITALL(NB_REQ,REQ_TAB,STATUSES,IERR)
- !DEALLOCATE(STATUSES)
- DO JI=1,NB_REQ ; DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
- END IF
- DEALLOCATE(T_TX2DP)
- DEALLOCATE(REQ_TAB)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_WAIT=TIMEZ%T_WRIT3D_WAIT + T1 - T0
- END DO Z_SLIDE
- !JUAN BG Z SLIDE
-! end of MNH_GA
-#endif
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
END IF ! multiprocessor execution
ELSE
IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X3','file '//TRIM(TPFILE%CNAME)//' not found')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X4','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
WRITE(YRESP, '( I6 )') IRESP
YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X3',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X4',YMSG)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
- IF (GALLOC_ll) DEALLOCATE(ZSLIDE_ll)
- !IF (Associated(ZSLIDE_ll)) DEALLOCATE(ZSLIDE_ll)
IF (PRESENT(KRESP)) KRESP = IRESP
- IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
- CALL SECOND_MNH2(T22)
- TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X3
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X4
- SUBROUTINE FMWRITX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
- INTEGER :: IHEXTOT
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITX4_ll','writing '//TRIM(HRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article 4 ' , HRECFM
- !------------------------------------------------------------------
- IHEXTOT = 2*JPHEXT+1
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- ELSE
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
- END IF
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:,:),ZFIELDP(:,1,:,:),TZFD%OWNER,TZFD%COMM)
- ELSE
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF ! multiprocessor execution
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITX4_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITX4_ll
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X4(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_X5(TPFILE,HNAME,PFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : TFILEDATA
!
@@ -2028,7 +1314,7 @@ CONTAINS
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
+ REAL,DIMENSION(:,:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
@@ -2036,7 +1322,7 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X4',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X5',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
@@ -2044,9 +1330,10 @@ CONTAINS
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X4
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_X5
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X4(TPFILE,TPFIELD,PFIELD,KRESP)
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_X5(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODD_IO_ll
USE MODD_PARAMETERS_ll,ONLY : JPHEXT
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
@@ -2064,7 +1351,7 @@ CONTAINS
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- REAL,DIMENSION(:,:,:,:),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) :: PFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
@@ -2077,7 +1364,7 @@ CONTAINS
INTEGER :: ISIZEMAX
TYPE(FD_ll), POINTER :: TZFD
INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
+ REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
@@ -2087,9 +1374,9 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X4',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X5',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,4,'IO_WRITE_FIELD_BYFIELD_X4')
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,5,'IO_WRITE_FIELD_BYFIELD_X5')
!
IRESP = 0
GALLOC = .FALSE.
@@ -2102,10 +1389,10 @@ CONTAINS
IF (GSMONOPROC) THEN ! sequential execution
! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:)
+ ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:,:)
! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:)
+ ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:,:)
IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,ZFIELDP,IRESP)
IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,ZFIELDP,IRESP)
ELSE
@@ -2119,7 +1406,7 @@ CONTAINS
CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
#endif
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X4','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X5','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
@@ -2127,7 +1414,7 @@ CONTAINS
IF (ISP == TZFD%OWNER) THEN
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,YDIR,GALLOC)
ELSE
- ALLOCATE(ZFIELDP(0,0,0,0))
+ ALLOCATE(ZFIELDP(0,0,0,0,0))
GALLOC = .TRUE.
END IF
!
@@ -2135,7 +1422,8 @@ CONTAINS
CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:,:),ZFIELDP(:,1,:,:),TZFD%OWNER,TZFD%COMM)
+ CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:,:,:),ZFIELDP(:,1,:,:,:),&
+ & TZFD%OWNER,TZFD%COMM)
ELSE
CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
END IF
@@ -2150,122 +1438,20 @@ CONTAINS
END IF ! multiprocessor execution
ELSE
IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X4','file '//TRIM(TPFILE%CNAME)//' not found')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X5','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
WRITE(YRESP, '( I6 )') IRESP
YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X4',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X5',YMSG)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X4
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X5
- SUBROUTINE FMWRITX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
- INTEGER :: IHEXTOT
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITX5_ll','writing '//TRIM(HRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !------------------------------------------------------------------
- IHEXTOT = 2*JPHEXT+1
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:,:)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:,:)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- ELSE
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
- END IF
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:,:,:),ZFIELDP(:,1,:,:,:),&
- & TZFD%OWNER,TZFD%COMM)
- ELSE
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF ! multiprocessor execution
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITX5_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITX5_ll
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X5(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_X6(TPFILE,HNAME,PFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : TFILEDATA
!
@@ -2273,7 +1459,7 @@ CONTAINS
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- REAL,DIMENSION(:,:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
+ REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
@@ -2281,7 +1467,7 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X5',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X6',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
@@ -2289,9 +1475,9 @@ CONTAINS
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X5
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_X6
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X5(TPFILE,TPFIELD,PFIELD,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_X6(TPFILE,TPFIELD,PFIELD,KRESP)
USE MODD_IO_ll
USE MODD_PARAMETERS_ll,ONLY : JPHEXT
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
@@ -2307,10 +1493,10 @@ CONTAINS
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
@@ -2322,7 +1508,7 @@ CONTAINS
INTEGER :: ISIZEMAX
TYPE(FD_ll), POINTER :: TZFD
INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
+ REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
@@ -2332,9 +1518,9 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X5',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X6',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,5,'IO_WRITE_FIELD_BYFIELD_X5')
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,6,'IO_WRITE_FIELD_BYFIELD_X6')
!
IRESP = 0
GALLOC = .FALSE.
@@ -2345,18 +1531,8 @@ CONTAINS
TZFD=>GETFD(YFNLFI)
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
- ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:,:)
- ! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:,:)
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,ZFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,ZFIELDP,IRESP)
- ELSE
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,PFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,PFIELD,IRESP)
- END IF
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,PFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,PFIELD,IRESP)
ELSE
#ifndef MNH_INT8
CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
@@ -2364,7 +1540,7 @@ CONTAINS
CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
#endif
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X5','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X6','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
@@ -2372,19 +1548,14 @@ CONTAINS
IF (ISP == TZFD%OWNER) THEN
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,YDIR,GALLOC)
ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0))
+ ALLOCATE(ZFIELDP(0,0,0,0,0,0))
GALLOC = .TRUE.
END IF
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
ELSEIF (YDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:,:,:),ZFIELDP(:,1,:,:,:),&
- & TZFD%OWNER,TZFD%COMM)
- ELSE
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
END IF
!
IF (ISP == TZFD%OWNER) THEN
@@ -2396,103 +1567,129 @@ CONTAINS
END IF ! multiprocessor execution
ELSE
IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X5','file '//TRIM(TPFILE%CNAME)//' not found')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X6','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
WRITE(YRESP, '( I6 )') IRESP
YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X5',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X6',YMSG)
END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X5
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X6
+
+
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_N0(TPFILE,HNAME,KFIELD,KRESP)
+ !
+ USE MODD_IO_ll, ONLY : TFILEDATA
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ INTEGER, INTENT(IN) :: KFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: ID ! Index of the field
+ INTEGER :: IRESP ! return_code
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+ !
+ IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+ !
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_N0
- SUBROUTINE FMWRITX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_N0(TPFILE,TPFIELD,KFIELD,KRESP)
+ USE MODD_IO_ll
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
+ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
+ !* 0. DECLARATIONS
+ ! ------------
!
!
!* 0.1 Declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ INTEGER, INTENT(IN) :: KFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ !JUANZIO
+ INTEGER :: IK_FILE,IK_RANK
+ CHARACTER(len=5) :: YK_FILE
+ CHARACTER(len=128) :: YFILE_IOZ
+ TYPE(FD_ll), POINTER :: TZFD_IOZ
+ TYPE(TFILEDATA),POINTER :: TZFILE
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITX6_ll','writing '//TRIM(HRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
- !* 1.1 THE NAME OF LFIFM
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPEINT,0,'IO_WRITE_FIELD_BYFIELD_N0')
!
IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article 6 ' , HRECFM
!------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
+ TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PFIELD),PFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,PFIELD,TZFMH,IRESP)
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- !
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,KFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,KFIELD,IRESP)
+ ELSE
IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,ZFIELDP,TZFMH,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,KFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,KFIELD,IRESP)
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
END IF ! multiprocessor execution
+ IF (TZFD%nb_procio.gt.1) THEN
+ ! write the data in all Z files
+ DO IK_FILE=1,TZFD%nb_procio
+ write(YK_FILE ,'(".Z",i3.3)') IK_FILE
+ YFILE_IOZ = TRIM(TPFILE%CNAME)//YK_FILE//".lfi"
+ TZFD_IOZ => GETFD(YFILE_IOZ)
+ IK_RANK = TZFD_IOZ%OWNER
+ IF ( ISP == IK_RANK ) THEN
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD_IOZ%FLU,KFIELD,IRESP)
+ IF (LIOCDF4) THEN
+ CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//YK_FILE,TZFILE,IRESP)
+ IF (IRESP/=0) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_WRITE_FIELD_BYFIELD_N0','file '//TRIM(TRIM(TPFILE%CNAME)//YK_FILE)//&
+ ' not found in list')
+ END IF
+ CALL IO_WRITE_FIELD_NC4(TZFILE,TPFIELD,TZFD_IOZ%CDF,KFIELD,IRESP)
+ END IF
+ END IF
+ END DO
+ ENDIF
ELSE
IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N0','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITX6_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
+ WRITE(YRESP, '( I6 )') IRESP
+ YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N0',YMSG)
END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITX6_ll
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N0
- SUBROUTINE IO_WRITE_FIELD_BYNAME_X6(TPFILE,HNAME,PFIELD,KRESP)
+
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_N1(TPFILE,HNAME,KFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : TFILEDATA
!
@@ -2500,7 +1697,7 @@ CONTAINS
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER,DIMENSION(:), INTENT(IN) :: KFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
@@ -2508,36 +1705,32 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_X6',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_X6
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_N1
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_X6(TPFILE,TPFIELD,PFIELD,KRESP)
- USE MODD_IO_ll
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_N1(TPFILE,TPFIELD,KFIELD,KRESP)
+ !
+ USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,TFILEDATA
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
USE MODE_ALLOCBUFFER_ll
USE MODE_GATHER_ll
- !JUANZ
- USE MODE_IO_ll, ONLY : io_file,io_rank
- USE MODD_TIMEZ, ONLY : TIMEZ
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
- !JUANZ
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
!
+ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ INTEGER,DIMENSION(:),TARGET, INTENT(IN) :: KFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
@@ -2549,9 +1742,8 @@ CONTAINS
INTEGER :: ISIZEMAX
TYPE(FD_ll), POINTER :: TZFD
INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
+ INTEGER,DIMENSION(:),POINTER :: IFIELDP
LOGICAL :: GALLOC
- INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
!
@@ -2559,161 +1751,228 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_X6',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEREAL,6,'IO_WRITE_FIELD_BYFIELD_X6')
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPEINT,1,'IO_WRITE_FIELD_BYFIELD_N1')
+ !
+ !* 1.1 THE NAME OF LFIFM
!
IRESP = 0
- GALLOC = .FALSE.
+ GALLOC = .FALSE.
YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
-!
!------------------------------------------------------------------
- IHEXTOT = 2*JPHEXT+1
TZFD=>GETFD(YFNLFI)
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,PFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,PFIELD,IRESP)
- ELSE
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,KFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,KFIELD,IRESP)
+ ELSE ! multiprocessor execution
#ifndef MNH_INT8
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
#else
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
#endif
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_X6','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_N1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,YDIR,GALLOC)
+ CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,YDIR,GALLOC)
ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0,0))
+ ALLOCATE(IFIELDP(0))
GALLOC = .TRUE.
END IF
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
- CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (YDIR == 'XY') THEN
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM)
+ CALL GATHER_XXFIELD(YDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
END IF
!
IF (ISP == TZFD%OWNER) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,ZFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,ZFIELDP,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF ! multiprocessor execution
+ END IF
ELSE
IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X6','file '//TRIM(TPFILE%CNAME)//' not found')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N1','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
WRITE(YRESP, '( I6 )') IRESP
YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_X6',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N1',YMSG)
END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
+ IF (GALLOC) DEALLOCATE(IFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_X6
+ IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N1
- SUBROUTINE FMWRITN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !* 0. DECLARATIONS
- ! ------------
+
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_N2(TPFILE,HNAME,KFIELD,KRESP)
!
+ USE MODD_IO_ll, ONLY : TFILEDATA
!
!* 0.1 Declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- INTEGER, INTENT(IN) ::KFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ INTEGER,DIMENSION(:,:), INTENT(IN) :: KFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
+ INTEGER :: ID ! Index of the field
+ INTEGER :: IRESP ! return_code
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N2',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+ !
+ IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+ !
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_N2
- !JUANZIO
- INTEGER :: IK_FILE,IK_rank
- CHARACTER(len=5) :: YK_FILE
- CHARACTER(len=128) :: YFILE_IOZ
- TYPE(FD_ll), POINTER :: TZFD_IOZ
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_N2(TPFILE,TPFIELD,KFIELD,KRESP)
+ USE MODD_IO_ll
+ USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ USE MODE_ALLOCBUFFER_ll
+ USE MODE_GATHER_ll
+ USE MODD_TIMEZ, ONLY : TIMEZ
+ USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITN0_ll','writing '//TRIM(HRECFM))
+ IMPLICIT NONE
!
- !JUANZIO
- !----------------------------------------------------------------
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) :: KFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=28) :: YFILEM ! FM-file name
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
+ CHARACTER(LEN=2) :: YDIR ! field form
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ INTEGER :: ISIZEMAX
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
+ LOGICAL :: GALLOC
+ !
+ !JUANZ
+ REAL*8,DIMENSION(2) :: T0,T1,T2
+ REAL*8,DIMENSION(2) :: T11,T22
+ !JUANZ
+ INTEGER :: IHEXTOT
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ !
+ YFILEM = TPFILE%CNAME
+ YRECFM = TPFIELD%CMNHNAME
+ YDIR = TPFIELD%CDIR
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N2',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ !
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPEINT,2,'IO_WRITE_FIELD_BYFIELD_N2')
!
!* 1.1 THE NAME OF LFIFM
!
+ CALL SECOND_MNH2(T11)
IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article N0 ' , HRECFM
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
!------------------------------------------------------------------
+ IHEXTOT = 2*JPHEXT+1
TZFD=>GETFD(YFNLFI)
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
- ELSE
+ IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ ! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ ELSE
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,KFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,KFIELD,IRESP)
+ END IF
+ ELSE ! multiprocessor execution
+#ifndef MNH_INT8
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
+#else
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
+#endif
+ IF (ISIZEMAX==0) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_N2','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
+ CALL SECOND_MNH2(T0)
IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
+ ! I/O processor case
+ CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,YDIR,GALLOC)
+ ELSE
+ ALLOCATE(IFIELDP(0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
+ CALL GATHER_XXFIELD(YDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (YDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ CALL GATHER_XXFIELD('XX',KFIELD(:,JPHEXT+1),IFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
+ ELSE
+ CALL GATHER_XYFIELD(KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
END IF
+ CALL SECOND_MNH2(T1)
+ TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ END IF
+ CALL SECOND_MNH2(T2)
+ TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
-
- END IF ! multiprocessor execution
- IF (TZFD%nb_procio.gt.1) THEN
- ! write the data in all Z files
- DO IK_FILE=1,TZFD%nb_procio
- write(YK_FILE ,'(".Z",i3.3)') IK_FILE
- YFILE_IOZ = TRIM(HFILEM)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- IK_RANK = TZFD_IOZ%OWNER
- IF ( ISP == IK_RANK ) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD_IOZ%FLU,HRECFM,.FALSE.,1,KFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD_IOZ%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
- END IF
- END DO
- ENDIF
- ELSE
+ END IF
+ ELSE
IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N2','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITN0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
+ WRITE(YRESP, '( I6 )') IRESP
+ YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N2',YMSG)
END IF
- KRESP = IRESP
- END SUBROUTINE FMWRITN0_ll
+ IF (GALLOC) DEALLOCATE(IFIELDP)
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
+ CALL SECOND_MNH2(T22)
+ TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N2
- SUBROUTINE IO_WRITE_FIELD_BYNAME_N0(TPFILE,HNAME,KFIELD,KRESP)
+
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_N3(TPFILE,HNAME,KFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : TFILEDATA
!
@@ -2721,7 +1980,7 @@ CONTAINS
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- INTEGER, INTENT(IN) :: KFIELD ! array containing the data field
+ INTEGER,DIMENSION(:,:,:), INTENT(IN) :: KFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
@@ -2729,7 +1988,7 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N3',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
@@ -2737,179 +1996,241 @@ CONTAINS
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_N0
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_N3
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_N0(TPFILE,TPFIELD,KFIELD,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_N3(TPFILE,TPFIELD,KFIELD,KRESP)
USE MODD_IO_ll
- USE MODD_FM
+ USE MODD_PARAMETERS_ll,ONLY : JPHEXT
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
- !* 0. DECLARATIONS
- ! ------------
+ USE MODE_ALLOCBUFFER_ll
+ USE MODE_GATHER_ll
+ USE MODD_TIMEZ, ONLY : TIMEZ
+ USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
!
+ IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- INTEGER, INTENT(IN) :: KFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ INTEGER,DIMENSION(:,:,:),TARGET,INTENT(IN) :: KFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- !JUANZIO
- INTEGER :: IK_FILE,IK_RANK
- CHARACTER(len=5) :: YK_FILE
- CHARACTER(len=128) :: YFILE_IOZ
- TYPE(FD_ll), POINTER :: TZFD_IOZ
- TYPE(TFILEDATA),POINTER :: TZFILE
+ CHARACTER(LEN=28) :: YFILEM ! FM-file name
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
+ CHARACTER(LEN=2) :: YDIR ! field form
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IERR
+ INTEGER :: ISIZEMAX
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ INTEGER,DIMENSION(:,:,:),POINTER :: IFIELDP
+ LOGICAL :: GALLOC
+ !
+ !JUANZ
+ REAL*8,DIMENSION(2) :: T11,T22
+ !JUANZ
+ INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ YFILEM = TPFILE%CNAME
+ YRECFM = TPFIELD%CMNHNAME
+ YDIR = TPFIELD%CDIR
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEINT,0,'IO_WRITE_FIELD_BYFIELD_N0')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N3',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ !
+ !* 1.1 THE NAME OF LFIFM
!
+ CALL SECOND_MNH2(T11)
IRESP = 0
+ GALLOC = .FALSE.
+ YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
!------------------------------------------------------------------
- TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
+ IHEXTOT = 2*JPHEXT+1
+ TZFD=>GETFD(YFNLFI)
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,KFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,KFIELD,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
+ IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ ! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1,:)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ ELSE
IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,KFIELD,IRESP)
IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,KFIELD,IRESP)
END IF
+ ELSE ! multiprocessor execution
+#ifndef MNH_INT8
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
+#else
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
+#endif
+ IF (ISIZEMAX==0) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_N3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
+ IF (ISP == TZFD%OWNER) THEN
+ ! I/O processor case
+ CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,YDIR,GALLOC)
+ ELSE
+ ALLOCATE(IFIELDP(0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
+ CALL GATHER_XXFIELD(YDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
+ ELSEIF (YDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ CALL GATHER_XXFIELD('XX',KFIELD(:,JPHEXT+1,:),IFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
+ ELSE
+ CALL GATHER_XYFIELD(KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
+ END IF
+ END IF
+ !
+ IF (ISP == TZFD%OWNER) THEN
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF ! multiprocessor execution
- IF (TZFD%nb_procio.gt.1) THEN
- ! write the data in all Z files
- DO IK_FILE=1,TZFD%nb_procio
- write(YK_FILE ,'(".Z",i3.3)') IK_FILE
- YFILE_IOZ = TRIM(TPFILE%CNAME)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- IK_RANK = TZFD_IOZ%OWNER
- IF ( ISP == IK_RANK ) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD_IOZ%FLU,KFIELD,IRESP)
- IF (LIOCDF4) THEN
- CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//YK_FILE,TZFILE,IRESP)
- IF (IRESP/=0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_WRITE_FIELD_BYFIELD_N0','file '//TRIM(TRIM(TPFILE%CNAME)//YK_FILE)//&
- ' not found in list')
- END IF
- CALL IO_WRITE_FIELD_NC4(TZFILE,TPFIELD,TZFD_IOZ%CDF,KFIELD,IRESP)
- END IF
- END IF
- END DO
- ENDIF
- ELSE
+ END IF
+ ELSE
IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N0','file '//TRIM(TPFILE%CNAME)//' not found')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N3','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N0',YMSG)
+ YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N3',YMSG)
END IF
+ IF (GALLOC) DEALLOCATE(IFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N0
+ IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
+ CALL SECOND_MNH2(T22)
+ TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N3
+
+
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_L0(TPFILE,HNAME,OFIELD,KRESP)
+ !
+ USE MODD_IO_ll, ONLY : TFILEDATA
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: ID ! Index of the field
+ INTEGER :: IRESP ! return_code
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+ !
+ IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
+ !
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_L0
- SUBROUTINE FMWRITN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_L0(TPFILE,TPFIELD,OFIELD,KRESP)
+ USE MODD_IO_ll
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
+ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
!* 0. DECLARATIONS
! ------------
!
!
!* 0.1 Declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- INTEGER,DIMENSION(:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=JPFINL) :: YFNLFI
INTEGER :: IERR
TYPE(FD_ll), POINTER :: TZFD
INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- INTEGER,DIMENSION(:),POINTER :: IFIELDP
- LOGICAL :: GALLOC
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITN1_ll','writing '//TRIM(HRECFM))
+ !JUANZIO
+ INTEGER :: IK_FILE,IK_RANK
+ CHARACTER(len=5) :: YK_FILE
+ CHARACTER(len=128) :: YFILE_IOZ
+ TYPE(FD_ll), POINTER :: TZFD_IOZ
+ TYPE(TFILEDATA),POINTER :: TZFILE
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
!
- !----------------------------------------------------------------
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
- !* 1.1 THE NAME OF LFIFM
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPELOG,0,'IO_WRITE_FIELD_BYFIELD_L0')
!
IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article N1 ' , HRECFM
!------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
+ TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,OFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,OFIELD,IRESP)
ELSE
IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(IFIELDP(0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,OFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,OFIELD,IRESP)
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
+ END IF ! multiprocessor execution
+ IF (TZFD%nb_procio.gt.1) THEN
+ ! write the data in all Z files
+ DO IK_FILE=1,TZFD%nb_procio
+ write(YK_FILE ,'(".Z",i3.3)') IK_FILE
+ YFILE_IOZ = TRIM(TPFILE%CNAME)//YK_FILE//".lfi"
+ TZFD_IOZ => GETFD(YFILE_IOZ)
+ IK_RANK = TZFD_IOZ%OWNER
+ IF ( ISP == IK_RANK ) THEN
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD_IOZ%FLU,OFIELD,IRESP)
+ IF (LIOCDF4) THEN
+ CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//YK_FILE,TZFILE,IRESP)
+ IF (IRESP/=0) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_WRITE_FIELD_BYFIELD_L0','file '//TRIM(TRIM(TPFILE%CNAME)//YK_FILE)//&
+ ' not found in list')
+ END IF
+ CALL IO_WRITE_FIELD_NC4(TZFILE,TPFIELD,TZFD_IOZ%CDF,OFIELD,IRESP)
+ END IF
+ END IF
+ END DO
+ ENDIF
+ ELSE
IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_L0','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITN1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
+ WRITE(YRESP, '( I6 )') IRESP
+ YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_L0',YMSG)
END IF
- IF (GALLOC) DEALLOCATE(IFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITN1_ll
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_L0
- SUBROUTINE IO_WRITE_FIELD_BYNAME_N1(TPFILE,HNAME,KFIELD,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_L1(TPFILE,HNAME,OFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : TFILEDATA
!
@@ -2917,7 +2238,7 @@ CONTAINS
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- INTEGER,DIMENSION(:), INTENT(IN) :: KFIELD ! array containing the data field
+ LOGICAL,DIMENSION(:), INTENT(IN) :: OFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
@@ -2925,18 +2246,18 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_L1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+ IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_N1
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_L1
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_N1(TPFILE,TPFIELD,KFIELD,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_L1(TPFILE,TPFIELD,OFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,TFILEDATA
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
@@ -2949,7 +2270,7 @@ CONTAINS
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- INTEGER,DIMENSION(:),TARGET, INTENT(IN) :: KFIELD ! array containing the data field
+ LOGICAL,DIMENSION(:),TARGET, INTENT(IN) :: OFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
@@ -2962,7 +2283,7 @@ CONTAINS
INTEGER :: ISIZEMAX
TYPE(FD_ll), POINTER :: TZFD
INTEGER :: IRESP
- INTEGER,DIMENSION(:),POINTER :: IFIELDP
+ LOGICAL,DIMENSION(:),POINTER :: GFIELDP
LOGICAL :: GALLOC
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
@@ -2971,9 +2292,9 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_L1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEINT,1,'IO_WRITE_FIELD_BYFIELD_N1')
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPELOG,1,'IO_WRITE_FIELD_BYFIELD_L1')
!
!* 1.1 THE NAME OF LFIFM
!
@@ -2984,320 +2305,251 @@ CONTAINS
TZFD=>GETFD(YFNLFI)
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,KFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,KFIELD,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,OFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,OFIELD,IRESP)
ELSE ! multiprocessor execution
#ifndef MNH_INT8
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
+ CALL MPI_ALLREDUCE(SIZE(OFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
#else
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
+ CALL MPI_ALLREDUCE(SIZE(OFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
#endif
IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_N1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_L1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,YDIR,GALLOC)
+ CALL ALLOCBUFFER_ll(GFIELDP,OFIELD,YDIR,GALLOC)
ELSE
- ALLOCATE(IFIELDP(0))
+ ALLOCATE(GFIELDP(0))
GALLOC = .TRUE.
END IF
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
- CALL GATHER_XXFIELD(YDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
+ CALL GATHER_XXFIELD(YDIR,OFIELD,GFIELDP,TZFD%OWNER,TZFD%COMM)
END IF
!
IF (ISP == TZFD%OWNER) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,GFIELDP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,GFIELDP,IRESP)
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
END IF
ELSE
IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N1','file '//TRIM(TPFILE%CNAME)//' not found')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_L1','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
WRITE(YRESP, '( I6 )') IRESP
YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N1',YMSG)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_L1',YMSG)
END IF
- IF (GALLOC) DEALLOCATE(IFIELDP)
+ IF (GALLOC) DEALLOCATE(GFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
!
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N1
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_L1
-
- SUBROUTINE FMWRITN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L1D,L2D
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
+
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_C0(TPFILE,HNAME,HFIELD,KRESP)
!
+ USE MODD_IO_ll, ONLY : TFILEDATA
!
!* 0.1 Declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
- INTEGER :: IHEXTOT
+ INTEGER :: ID ! Index of the field
+ INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITN2_ll','writing '//TRIM(HRECFM))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
- !* 1.1 THE NAME OF LFIFM
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+ !
+ IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
+ !
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_C0
+
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_C0(TPFILE,TPFIELD,HFIELD,KRESP)
+ USE MODD_IO_ll
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ !
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPECHAR,0,'IO_WRITE_FIELD_BYFIELD_C0')
!
IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article N2 ' , HRECFM
!
- IHEXTOT = 2*JPHEXT+1
- TZFD=>GETFD(YFNLFI)
+ IF (LEN(HFIELD)==0 .AND. LLFIOUT) THEN
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C0',&
+ 'zero-size string not allowed if LFI output for '//TRIM(TPFIELD%CMNHNAME))
+ END IF
+ !------------------------------------------------------------------
+ TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- ! IF (LPACK .AND. L1D .AND. HDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
- ! ELSE IF (LPACK .AND. L2D .AND. HDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
- ELSE
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(KFIELD),KFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,KFIELD,TZFMH,IRESP)
- END IF
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,HDIR,GALLOC)
- ELSE
- ALLOCATE(IFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (HDIR == 'XX' .OR. HDIR =='YY') THEN
- CALL GATHER_XXFIELD(HDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (HDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',KFIELD(:,JPHEXT+1),IFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
- ELSE
- CALL GATHER_XYFIELD(KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- !
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,HFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,HFIELD,IRESP)
+ ELSE
IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELDP),IFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELDP,TZFMH,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,HFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,HFIELD,IRESP)
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
END IF
-
- ELSE
+ ELSE
IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C0','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITN2_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH,IRESP)
+ WRITE(YRESP, '( I6 )') IRESP
+ YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C0',YMSG)
END IF
- IF (GALLOC) DEALLOCATE(IFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITN2_ll
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_C0
- SUBROUTINE IO_WRITE_FIELD_BYNAME_N2(TPFILE,HNAME,KFIELD,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_C1(TPFILE,HNAME,HFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : TFILEDATA
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- INTEGER,DIMENSION(:,:), INTENT(IN) :: KFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N2',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
+ IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_N2
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_C1
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_N2(TPFILE,TPFIELD,KFIELD,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_C1(TPFILE,TPFIELD,HFIELD,KRESP)
USE MODD_IO_ll
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- USE MODD_TIMEZ, ONLY : TIMEZ
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
+ !* 0. DECLARATIONS
+ ! ------------
!
- IMPLICIT NONE
!
!* 0.1 Declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) :: KFIELD ! array containing the data field
+ CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=28) :: YFILEM ! FM-file name
- CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
- CHARACTER(LEN=2) :: YDIR ! field form
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- INTEGER :: ISIZEMAX
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
- LOGICAL :: GALLOC
- !
- !JUANZ
- REAL*8,DIMENSION(2) :: T0,T1,T2
- REAL*8,DIMENSION(2) :: T11,T22
- !JUANZ
- INTEGER :: IHEXTOT
- CHARACTER(LEN=:),ALLOCATABLE :: YMSG
- CHARACTER(LEN=6) :: YRESP
- !
- YFILEM = TPFILE%CNAME
- YRECFM = TPFIELD%CMNHNAME
- YDIR = TPFIELD%CDIR
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N2',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ INTEGER :: J,JJ
+ INTEGER :: ILE, IP
+ INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
+ INTEGER :: ILENG
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEINT,2,'IO_WRITE_FIELD_BYFIELD_N2')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
- !* 1.1 THE NAME OF LFIFM
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPECHAR,1,'IO_WRITE_FIELD_BYFIELD_C1')
!
- CALL SECOND_MNH2(T11)
IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
+ !
+ IF(LLFIOUT) THEN
+ ILE=LEN(HFIELD)
+ IP=SIZE(HFIELD)
+ ILENG=ILE*IP
+ !
+ IF (ILENG==0) THEN
+ IP=1
+ ILE=1
+ ILENG=1
+ ALLOCATE(IFIELD(1))
+ IFIELD(1)=IACHAR(' ')
+ ELSE
+ ALLOCATE(IFIELD(ILENG))
+ DO JJ=1,IP
+ DO J=1,ILE
+ IFIELD(ILE*(JJ-1)+J)=IACHAR(HFIELD(JJ)(J:J))
+ END DO
+ END DO
+ END IF
+ END IF
!------------------------------------------------------------------
- IHEXTOT = 2*JPHEXT+1
- TZFD=>GETFD(YFNLFI)
+ TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
- ! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1)
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
- ELSE
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,KFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,KFIELD,IRESP)
- END IF
- ELSE ! multiprocessor execution
-#ifndef MNH_INT8
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
-#endif
- IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_N2','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
- IF (PRESENT(KRESP)) KRESP=0
- RETURN
- END IF
-
- CALL SECOND_MNH2(T0)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,HFIELD,IRESP)
+ ELSE
IF (ISP == TZFD%OWNER) THEN
- ! I/O processor case
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,YDIR,GALLOC)
- ELSE
- ALLOCATE(IFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
- CALL GATHER_XXFIELD(YDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (YDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',KFIELD(:,JPHEXT+1),IFIELDP(:,1),TZFD%OWNER,TZFD%COMM)
- ELSE
- CALL GATHER_XYFIELD(KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
- !
- IF (ISP == TZFD%OWNER) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,HFIELD,IRESP)
END IF
- CALL SECOND_MNH2(T2)
- TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
END IF
- ELSE
+ ELSE
IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N2','file '//TRIM(TPFILE%CNAME)//' not found')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C1','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N2',YMSG)
+ YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C1',YMSG)
END IF
- IF (GALLOC) DEALLOCATE(IFIELDP)
+ IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
IF (PRESENT(KRESP)) KRESP = IRESP
- IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
- CALL SECOND_MNH2(T22)
- TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
- !
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N2
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_C1
- SUBROUTINE IO_WRITE_FIELD_BYNAME_N3(TPFILE,HNAME,KFIELD,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_T0(TPFILE,HNAME,TFIELD,KRESP)
!
USE MODD_IO_ll, ONLY : TFILEDATA
!
@@ -3305,7 +2557,7 @@ CONTAINS
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- INTEGER,DIMENSION(:,:,:), INTENT(IN) :: KFIELD ! array containing the data field
+ TYPE (DATE_TIME), INTENT(IN) :: TFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
@@ -3313,247 +2565,21 @@ CONTAINS
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_N3',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),KFIELD,IRESP)
- !
- IF (PRESENT(KRESP)) KRESP = IRESP
- !
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_N3
-
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_N3(TPFILE,TPFIELD,KFIELD,KRESP)
- USE MODD_IO_ll
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- USE MODD_TIMEZ, ONLY : TIMEZ
- USE MODE_MNH_TIMING, ONLY : SECOND_MNH2
- !
- IMPLICIT NONE
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- INTEGER,DIMENSION(:,:,:),TARGET,INTENT(IN) :: KFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=28) :: YFILEM ! FM-file name
- CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
- CHARACTER(LEN=2) :: YDIR ! field form
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- INTEGER :: ISIZEMAX
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- INTEGER,DIMENSION(:,:,:),POINTER :: IFIELDP
- LOGICAL :: GALLOC
- !
- !JUANZ
- REAL*8,DIMENSION(2) :: T11,T22
- !JUANZ
- INTEGER :: IHEXTOT
- CHARACTER(LEN=:),ALLOCATABLE :: YMSG
- CHARACTER(LEN=6) :: YRESP
- !
- YFILEM = TPFILE%CNAME
- YRECFM = TPFIELD%CMNHNAME
- YDIR = TPFIELD%CDIR
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_N3',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
+ IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),TFIELD,IRESP)
!
- CALL SECOND_MNH2(T11)
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
- !------------------------------------------------------------------
- IHEXTOT = 2*JPHEXT+1
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
- ! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1,:)
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
- ELSE
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,KFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,KFIELD,IRESP)
- END IF
- ELSE ! multiprocessor execution
-#ifndef MNH_INT8
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
-#endif
- IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_N3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
- IF (PRESENT(KRESP)) KRESP=0
- RETURN
- END IF
-
- IF (ISP == TZFD%OWNER) THEN
- ! I/O processor case
- CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,YDIR,GALLOC)
- ELSE
- ALLOCATE(IFIELDP(0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
- CALL GATHER_XXFIELD(YDIR,KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
- ELSEIF (YDIR == 'XY') THEN
- IF (LPACK .AND. L2D) THEN
- CALL GATHER_XXFIELD('XX',KFIELD(:,JPHEXT+1,:),IFIELDP(:,1,:),TZFD%OWNER,TZFD%COMM)
- ELSE
- CALL GATHER_XYFIELD(KFIELD,IFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,IFIELDP,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N3','file '//TRIM(TPFILE%CNAME)//' not found')
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_N3',YMSG)
- END IF
- IF (GALLOC) DEALLOCATE(IFIELDP)
IF (PRESENT(KRESP)) KRESP = IRESP
- IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
- CALL SECOND_MNH2(T22)
- TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
- !
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_N3
-
-
- SUBROUTINE FMWRITL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- LOGICAL, INTENT(IN) ::OFIELD ! array containing the data field
- INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: IFIELD
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITL0_ll','writing '//TRIM(HRECFM))
!
- !----------------------------------------------------------------
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article L0 ' , HRECFM
- IF (OFIELD) THEN
- IFIELD=1
- ELSE
- IFIELD=0
- END IF
- !----------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,1,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
- END IF
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITL0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- KRESP = IRESP
- END SUBROUTINE FMWRITL0_ll
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_T0
- SUBROUTINE IO_WRITE_FIELD_BYNAME_L0(TPFILE,HNAME,OFIELD,KRESP)
- !
- USE MODD_IO_ll, ONLY : TFILEDATA
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: ID ! Index of the field
- INTEGER :: IRESP ! return_code
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
- !
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
- !
- IF (PRESENT(KRESP)) KRESP = IRESP
- !
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_L0
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_L0(TPFILE,TPFIELD,OFIELD,KRESP)
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_T0(TPFILE,TPFIELD,TFIELD,KRESP)
USE MODD_IO_ll
- USE MODD_FM
+ USE MODD_TYPE_DATE
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME
!* 0. DECLARATIONS
! ------------
!
@@ -3562,7 +2588,7 @@ CONTAINS
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field
+ TYPE (DATE_TIME), INTENT(IN) :: TFIELD ! array containing the data field
INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
@@ -3570,1500 +2596,225 @@ CONTAINS
INTEGER :: IERR
TYPE(FD_ll), POINTER :: TZFD
INTEGER :: IRESP
- !JUANZIO
- INTEGER :: IK_FILE,IK_RANK
- CHARACTER(len=5) :: YK_FILE
- CHARACTER(len=128) :: YFILE_IOZ
- TYPE(FD_ll), POINTER :: TZFD_IOZ
- TYPE(TFILEDATA),POINTER :: TZFILE
- CHARACTER(LEN=:),ALLOCATABLE :: YMSG
- CHARACTER(LEN=6) :: YRESP
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPELOG,0,'IO_WRITE_FIELD_BYFIELD_L0')
+ CALL FIELD_METADATA_CHECK(TPFIELD,TYPEDATE,0,'IO_WRITE_FIELD_BYFIELD_T0')
!
IRESP = 0
+ !
!------------------------------------------------------------------
TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
IF (ASSOCIATED(TZFD)) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,OFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,OFIELD,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,OFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,OFIELD,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF ! multiprocessor execution
- IF (TZFD%nb_procio.gt.1) THEN
- ! write the data in all Z files
- DO IK_FILE=1,TZFD%nb_procio
- write(YK_FILE ,'(".Z",i3.3)') IK_FILE
- YFILE_IOZ = TRIM(TPFILE%CNAME)//YK_FILE//".lfi"
- TZFD_IOZ => GETFD(YFILE_IOZ)
- IK_RANK = TZFD_IOZ%OWNER
- IF ( ISP == IK_RANK ) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD_IOZ%FLU,OFIELD,IRESP)
- IF (LIOCDF4) THEN
- CALL IO_FILE_FIND_BYNAME(TRIM(TPFILE%CNAME)//YK_FILE,TZFILE,IRESP)
- IF (IRESP/=0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_WRITE_FIELD_BYFIELD_L0','file '//TRIM(TRIM(TPFILE%CNAME)//YK_FILE)//&
- ' not found in list')
- END IF
- CALL IO_WRITE_FIELD_NC4(TZFILE,TPFIELD,TZFD_IOZ%CDF,OFIELD,IRESP)
- END IF
- END IF
- END DO
- ENDIF
- ELSE
- IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_L0','file '//TRIM(TPFILE%CNAME)//' not found')
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_L0',YMSG)
- END IF
- IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_L0
-
-
-
- SUBROUTINE FMWRITL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
-
- !* 0. DECLARATIONS
- ! ------------
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- LOGICAL,DIMENSION(:),INTENT(IN) ::OFIELD ! array containing the data field
- INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITL1_ll','writing '//TRIM(HRECFM))
- !
- !----------------------------------------------------------------
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article L1 ' , HRECFM
- WHERE (OFIELD)
- IFIELD=1
- ELSEWHERE
- IFIELD=0
- END WHERE
- !----------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,SIZE(IFIELD),IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,IFIELD,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITL1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- KRESP = IRESP
- END SUBROUTINE FMWRITL1_ll
-
- SUBROUTINE IO_WRITE_FIELD_BYNAME_L1(TPFILE,HNAME,OFIELD,KRESP)
- !
- USE MODD_IO_ll, ONLY : TFILEDATA
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- LOGICAL,DIMENSION(:), INTENT(IN) :: OFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: ID ! Index of the field
- INTEGER :: IRESP ! return_code
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_L1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
- !
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
- !
- IF (PRESENT(KRESP)) KRESP = IRESP
- !
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_L1
-
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_L1(TPFILE,TPFIELD,OFIELD,KRESP)
- !
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT,TFILEDATA
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_ALLOCBUFFER_ll
- USE MODE_GATHER_ll
- !
- IMPLICIT NONE
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- LOGICAL,DIMENSION(:),TARGET, INTENT(IN) :: OFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=28) :: YFILEM ! FM-file name
- CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
- CHARACTER(LEN=2) :: YDIR ! field form
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- INTEGER :: ISIZEMAX
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- LOGICAL,DIMENSION(:),POINTER :: GFIELDP
- LOGICAL :: GALLOC
- CHARACTER(LEN=:),ALLOCATABLE :: YMSG
- CHARACTER(LEN=6) :: YRESP
- !
- YFILEM = TPFILE%CNAME
- YRECFM = TPFIELD%CMNHNAME
- YDIR = TPFIELD%CDIR
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_L1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
- !
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPELOG,1,'IO_WRITE_FIELD_BYFIELD_L1')
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,OFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,OFIELD,IRESP)
- ELSE ! multiprocessor execution
-#ifndef MNH_INT8
- CALL MPI_ALLREDUCE(SIZE(OFIELD),ISIZEMAX,1,MPI_INTEGER,MPI_MAX,TZFD%COMM,IRESP)
-#else
- CALL MPI_ALLREDUCE(SIZE(OFIELD),ISIZEMAX,1,MPI_INTEGER8,MPI_MAX,TZFD%COMM,IRESP)
-#endif
- IF (ISIZEMAX==0) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_WRITE_FIELD_BYFIELD_L1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
- IF (PRESENT(KRESP)) KRESP=0
- RETURN
- END IF
-
- IF (ISP == TZFD%OWNER) THEN
- CALL ALLOCBUFFER_ll(GFIELDP,OFIELD,YDIR,GALLOC)
- ELSE
- ALLOCATE(GFIELDP(0))
- GALLOC = .TRUE.
- END IF
- !
- IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
- CALL GATHER_XXFIELD(YDIR,OFIELD,GFIELDP,TZFD%OWNER,TZFD%COMM)
- END IF
- !
- IF (ISP == TZFD%OWNER) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,GFIELDP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,GFIELDP,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_L1','file '//TRIM(TPFILE%CNAME)//' not found')
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_L1',YMSG)
- END IF
- IF (GALLOC) DEALLOCATE(GFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
- IF (ASSOCIATED(TZFD)) CALL MPI_BARRIER(TZFD%COMM,IERR)
- !
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_L1
-
-
- SUBROUTINE FMWRITC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- CHARACTER(LEN=*), INTENT(IN) ::HFIELD ! array containing the data field
- INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: JLOOP
- INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
- INTEGER :: ILENG
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITC0_ll','writing '//TRIM(HRECFM))
- !
- !----------------------------------------------------------------
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article C0 ' , HRECFM
- ILENG=LEN(HFIELD)
- !
- IF (ILENG==0) THEN
- ILENG=1
- ALLOCATE(IFIELD(1))
- IFIELD(1)=IACHAR(' ')
- ELSE
- ALLOCATE(IFIELD(ILENG))
- DO JLOOP=1,ILENG
- IFIELD(JLOOP)=IACHAR(HFIELD(JLOOP:JLOOP))
- END DO
- END IF
- !----------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITC0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
- KRESP = IRESP
- END SUBROUTINE FMWRITC0_ll
-
- SUBROUTINE IO_WRITE_FIELD_BYNAME_C0(TPFILE,HNAME,HFIELD,KRESP)
- !
- USE MODD_IO_ll, ONLY : TFILEDATA
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: ID ! Index of the field
- INTEGER :: IRESP ! return_code
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
- !
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
- !
- IF (PRESENT(KRESP)) KRESP = IRESP
- !
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_C0
-
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_C0(TPFILE,TPFIELD,HFIELD,KRESP)
- USE MODD_IO_ll
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !* 0. DECLARATIONS
- ! ------------
- !
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- CHARACTER(LEN=:),ALLOCATABLE :: YMSG
- CHARACTER(LEN=6) :: YRESP
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
- !
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPECHAR,0,'IO_WRITE_FIELD_BYFIELD_C0')
- !
- IRESP = 0
- !
- IF (LEN(HFIELD)==0 .AND. LLFIOUT) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C0',&
- 'zero-size string not allowed if LFI output for '//TRIM(TPFIELD%CMNHNAME))
- END IF
- !------------------------------------------------------------------
- TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,HFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,HFIELD,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,HFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,HFIELD,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C0','file '//TRIM(TPFILE%CNAME)//' not found')
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C0',YMSG)
- END IF
- IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_C0
-
- SUBROUTINE FMWRITC1_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) ::HFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: J,JJ
- INTEGER :: ILE, IP
- INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
- INTEGER :: ILENG
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITC1_ll','writing '//TRIM(HRECFM))
- !
- !----------------------------------------------------------------
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article C1 ' , HRECFM
- ILE=LEN(HFIELD)
- IP=SIZE(HFIELD)
- ILENG=ILE*IP
- !
- IF (ILENG==0) THEN
- IP=1
- ILE=1
- ILENG=1
- ALLOCATE(IFIELD(1))
- IFIELD(1)=IACHAR(' ')
- ELSE
- ALLOCATE(IFIELD(ILENG))
- DO JJ=1,IP
- DO J=1,ILE
- IFIELD(ILE*(JJ-1)+J)=IACHAR(HFIELD(JJ)(J:J))
- END DO
- END DO
- END IF
- !----------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.FALSE.,ILENG,IFIELD,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,HDIR,HFIELD,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITC1_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
- KRESP = IRESP
- END SUBROUTINE FMWRITC1_ll
-
- SUBROUTINE IO_WRITE_FIELD_BYNAME_C1(TPFILE,HNAME,HFIELD,KRESP)
- !
- USE MODD_IO_ll, ONLY : TFILEDATA
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: ID ! Index of the field
- INTEGER :: IRESP ! return_code
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
- !
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),HFIELD,IRESP)
- !
- IF (PRESENT(KRESP)) KRESP = IRESP
- !
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_C1
-
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_C1(TPFILE,TPFIELD,HFIELD,KRESP)
- USE MODD_IO_ll
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !* 0. DECLARATIONS
- ! ------------
- !
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- INTEGER :: J,JJ
- INTEGER :: ILE, IP
- INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
- INTEGER :: ILENG
- CHARACTER(LEN=:),ALLOCATABLE :: YMSG
- CHARACTER(LEN=6) :: YRESP
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
- !
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPECHAR,1,'IO_WRITE_FIELD_BYFIELD_C1')
- !
- IRESP = 0
- !
- IF(LLFIOUT) THEN
- ILE=LEN(HFIELD)
- IP=SIZE(HFIELD)
- ILENG=ILE*IP
- !
- IF (ILENG==0) THEN
- IP=1
- ILE=1
- ILENG=1
- ALLOCATE(IFIELD(1))
- IFIELD(1)=IACHAR(' ')
- ELSE
- ALLOCATE(IFIELD(ILENG))
- DO JJ=1,IP
- DO J=1,ILE
- IFIELD(ILE*(JJ-1)+J)=IACHAR(HFIELD(JJ)(J:J))
- END DO
- END DO
- END IF
- END IF
- !------------------------------------------------------------------
- TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,HFIELD,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,IFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,HFIELD,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C1','file '//TRIM(TPFILE%CNAME)//' not found')
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_C1',YMSG)
- END IF
- IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
- IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_C1
-
- SUBROUTINE FMWRITT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_TYPE_DATE
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- TYPE (DATE_TIME), INTENT(IN) ::TFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !--------------------------------------------------------------------
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- TYPE(FMHEADER) :: TZFMH
- INTEGER, DIMENSION(3) :: ITDATE ! date array
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITT0_ll','writing '//TRIM(HRECFM))
- !
- !-------------------------------------------------------------------------------
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article T0 ' , HRECFM
- ITDATE(1)=TFIELD%TDATE%YEAR
- ITDATE(2)=TFIELD%TDATE%MONTH
- ITDATE(3)=TFIELD%TDATE%DAY
- !-------------------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMMENT='YYYYMMDD'
- TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
- & ,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TDATE',HDIR,ITDATE,TZFMH,IRESP)
- TZFMH%COMMENT='SECONDS'
- TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
- & ,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TIME',HDIR,TFIELD%TIME,TZFMH,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID=KGRID
- TZFMH%COMMENT='YYYYMMDD'
- TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TDATE',.FALSE.,3,ITDATE&
- & ,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TDATE',HDIR,ITDATE,TZFMH,IRESP)
- TZFMH%COMMENT='SECONDS'
- TZFMH%COMLEN=LEN_TRIM(TZFMH%COMMENT)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,TRIM(HRECFM)//'%TIME',.TRUE.,1,TFIELD%TIME&
- & ,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,TRIM(HRECFM)//'%TIME',HDIR,TFIELD%TIME,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITT0_ll",HFILEM,HFIPRI,HRECFM,HDIR,KGRID,KLENCH&
- & ,IRESP)
- END IF
- KRESP = IRESP
- END SUBROUTINE FMWRITT0_ll
-
- SUBROUTINE IO_WRITE_FIELD_BYNAME_T0(TPFILE,HNAME,TFIELD,KRESP)
- !
- USE MODD_IO_ll, ONLY : TFILEDATA
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- TYPE (DATE_TIME), INTENT(IN) :: TFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: ID ! Index of the field
- INTEGER :: IRESP ! return_code
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
- !
- IF(IRESP==0) CALL IO_WRITE_FIELD(TPFILE,TFIELDLIST(ID),TFIELD,IRESP)
- !
- IF (PRESENT(KRESP)) KRESP = IRESP
- !
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_T0
-
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_T0(TPFILE,TPFIELD,TFIELD,KRESP)
- USE MODD_IO_ll
- USE MODD_FM
- USE MODD_TYPE_DATE
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !* 0. DECLARATIONS
- ! ------------
- !
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- TYPE (DATE_TIME), INTENT(IN) :: TFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- CHARACTER(LEN=:),ALLOCATABLE :: YMSG
- CHARACTER(LEN=6) :: YRESP
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
- !
- CALL FIELD_METADATA_CHECK(TPFIELD,TYPEDATE,0,'IO_WRITE_FIELD_BYFIELD_T0')
- !
- IRESP = 0
- !
- !------------------------------------------------------------------
- TZFD=>GETFD(TRIM(ADJUSTL(TPFILE%CNAME))//'.lfi')
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,TFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,TFIELD,IRESP)
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,TFIELD,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,TFIELD,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
- END IF
- ELSE
- IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_T0','file '//TRIM(TPFILE%CNAME)//' not found')
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_T0',YMSG)
- END IF
- IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_T0
-
- SUBROUTINE FMWRIT_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
- & KGRID,KLENCH,HCOMMENT,KRESP)
- USE MODD_IO_ll, ONLY : ISP,ISNPROC,GSMONOPROC,LIOCDF4,LLFIOUT,LPACK,L2D
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
- USE MODD_FM
- USE MODE_DISTRIB_LB
- USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- !
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints in FM
- CHARACTER(LEN=*), INTENT(IN) ::HLBTYPE! 'LBX','LBXU','LBY' or 'LBYV'
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PLB ! array containing the LB field
- INTEGER, INTENT(IN) ::KRIM ! size of the LB area
- INTEGER, INTENT(IN) ::KL3D ! size of the LB array in FM
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
- REAL,DIMENSION(:,:,:), POINTER :: TX3DP
- TYPE(FMHEADER) :: TZFMH
- INTEGER :: IIMAX_ll,IJMAX_ll
- INTEGER :: JI
- INTEGER :: IIB,IIE,IJB,IJE
- INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
- INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
- INTEGER :: NB_REQ,IKU
- TYPE TX_3DP
- REAL,DIMENSION(:,:,:), POINTER :: X
- END TYPE TX_3DP
- TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRIT_LB','writing '//TRIM(HRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article LB ' , HRECFM
- IF (KL3D /= 2*(KRIM+JPHEXT)) THEN
- IRESP = -30
- GOTO 1000
- END IF
- !
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LPACK .AND. L2D) THEN
- TX3DP=>PLB(:,JPHEXT+1:JPHEXT+1,:)
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',TX3DP,TZFMH,IRESP)
- ELSE
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(PLB),PLB,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',PLB,TZFMH,IRESP)
- END IF
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- ! I/O proc case
- CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
- IF (HLBTYPE == 'LBX' .OR. HLBTYPE == 'LBXU') THEN
- ALLOCATE(Z3D((KRIM+JPHEXT)*2,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
- ELSE ! HLBTYPE == 'LBY' .OR. HLBTYPE == 'LBYV'
- ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,(KRIM+JPHEXT)*2,SIZE(PLB,3)))
- END IF
- DO JI = 1,ISNPROC
- CALL GET_DISTRIB_LB(HLBTYPE,JI,'FM','WRITE',KRIM,IIB,IIE,IJB,IJE)
- IF (IIB /= 0) THEN
- TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
- IF (ISP /= JI) THEN
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,STATUS,IERR)
- ELSE
- CALL GET_DISTRIB_LB(HLBTYPE,JI,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
- TX3DP = PLB(IIB:IIE,IJB:IJE,:)
- END IF
- END IF
- END DO
- TZFMH%GRID=KGRID
- TZFMH%COMLEN=KLENCH
- TZFMH%COMMENT=HCOMMENT
- IF (LPACK .AND. L2D) THEN
- TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
- ELSE
- TX3DP=>Z3D
- END IF
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(TX3DP),TX3DP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',TX3DP,TZFMH,IRESP)
- ELSE
- NB_REQ=0
- ALLOCATE(REQ_TAB(1))
- ALLOCATE(T_TX3DP(1))
- IKU = SIZE(PLB,3)
- ! Other processors
- CALL GET_DISTRIB_LB(HLBTYPE,ISP,'LOC','WRITE',KRIM,IIB,IIE,IJB,IJE)
- IF (IIB /= 0) THEN
- TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
- T_TX3DP(NB_REQ)%X=PLB(IIB:IIE,IJB:IJE,:)
- CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,IERR)
- END IF
- IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- DEALLOCATE(T_TX3DP(1)%X)
- END IF
- DEALLOCATE(T_TX3DP,REQ_TAB)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- END IF !(GSMONOPROC)
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
-1000 CONTINUE
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRIT_LB",HFILEM,HFIPRI,HRECFM,HLBTYPE,KGRID,KLENCH,IRESP)
- END IF
- !
- IF (ALLOCATED(Z3D)) DEALLOCATE(Z3D)
- KRESP = IRESP
- END SUBROUTINE FMWRIT_LB
-
- SUBROUTINE IO_WRITE_FIELD_BYNAME_LB(TPFILE,HNAME,KL3D,PLB,KRESP)
- !
- USE MODD_IO_ll, ONLY : TFILEDATA
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- INTEGER, INTENT(IN) :: KL3D ! size of the LB array in FM
- REAL,DIMENSION(:,:,:), INTENT(IN) :: PLB ! array containing the LB field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- INTEGER :: ID ! Index of the field
- INTEGER :: IRESP ! return_code
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_LB',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
- !
- IF(IRESP==0) CALL IO_WRITE_FIELD_LB(TPFILE,TFIELDLIST(ID),KL3D,PLB,IRESP)
- !
- IF (PRESENT(KRESP)) KRESP = IRESP
- !
- END SUBROUTINE IO_WRITE_FIELD_BYNAME_LB
-
- SUBROUTINE IO_WRITE_FIELD_BYFIELD_LB(TPFILE,TPFIELD,KL3D,PLB,KRESP)
- !
- USE MODD_IO_ll
- USE MODD_PARAMETERS_ll,ONLY : JPHEXT
- USE MODD_FM
- USE MODE_DISTRIB_LB
- USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_ll
- !
- USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
- !
- !* 0.1 Declarations of arguments
- !
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
- INTEGER, INTENT(IN) :: KL3D ! size of the LB array in FM
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: PLB ! array containing the LB field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=28) :: YFILEM ! FM-file name
- CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
- CHARACTER(LEN=4) :: YLBTYPE ! 'LBX','LBXU','LBY' or 'LBYV'
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IRIM ! size of the LB area
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
- REAL,DIMENSION(:,:,:), POINTER :: TX3DP
- INTEGER :: IIMAX_ll,IJMAX_ll
- INTEGER :: JI
- INTEGER :: IIB,IIE,IJB,IJE
- INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
- INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
- INTEGER :: NB_REQ,IKU
- TYPE TX_3DP
- REAL,DIMENSION(:,:,:), POINTER :: X
- END TYPE TX_3DP
- TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
- CHARACTER(LEN=:),ALLOCATABLE :: YMSG
- CHARACTER(LEN=6) :: YRESP
- !
- YFILEM = TPFILE%CNAME
- YRECFM = TPFIELD%CMNHNAME
- YLBTYPE = TPFIELD%CLBTYPE
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_LB',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
- !
- IF (YLBTYPE/='LBX' .AND. YLBTYPE/='LBXU' .AND. YLBTYPE/='LBY' .AND. YLBTYPE/='LBYV') THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_LB','unknown LBTYPE ('//YLBTYPE//')')
- RETURN
- END IF
- !
- IF (TPFIELD%CDIR/='XY') THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_BYFIELD_LB','CDIR was not set to "XY" for '//TRIM(YRECFM))
- TPFIELD%CDIR='XY'
- END IF
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
- !
- IRIM = (KL3D-2*JPHEXT)/2
- IF (KL3D /= 2*(IRIM+JPHEXT)) THEN
- IRESP = -30
- GOTO 1000
- END IF
- !
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L2D) THEN
- TX3DP=>PLB(:,JPHEXT+1:JPHEXT+1,:)
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,TX3DP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,TX3DP,IRESP)
- ELSE
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,PLB,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,PLB,IRESP)
- END IF
- ELSE
- IF (ISP == TZFD%OWNER) THEN
- ! I/O proc case
- CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
- IF (YLBTYPE == 'LBX' .OR. YLBTYPE == 'LBXU') THEN
- ALLOCATE(Z3D((IRIM+JPHEXT)*2,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
- ELSE ! YLBTYPE == 'LBY' .OR. YLBTYPE == 'LBYV'
- ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,(IRIM+JPHEXT)*2,SIZE(PLB,3)))
- END IF
- DO JI = 1,ISNPROC
- CALL GET_DISTRIB_LB(YLBTYPE,JI,'FM','WRITE',IRIM,IIB,IIE,IJB,IJE)
- IF (IIB /= 0) THEN
- TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
- IF (ISP /= JI) THEN
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,STATUS,IERR)
- ELSE
- CALL GET_DISTRIB_LB(YLBTYPE,JI,'LOC','WRITE',IRIM,IIB,IIE,IJB,IJE)
- TX3DP = PLB(IIB:IIE,IJB:IJE,:)
- END IF
- END IF
- END DO
- IF (LPACK .AND. L2D) THEN
- TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
- ELSE
- TX3DP=>Z3D
- END IF
- IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,TX3DP,IRESP)
- IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,TX3DP,IRESP)
- ELSE
- NB_REQ=0
- ALLOCATE(REQ_TAB(1))
- ALLOCATE(T_TX3DP(1))
- IKU = SIZE(PLB,3)
- ! Other processors
- CALL GET_DISTRIB_LB(YLBTYPE,ISP,'LOC','WRITE',IRIM,IIB,IIE,IJB,IJE)
- IF (IIB /= 0) THEN
- TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
- T_TX3DP(NB_REQ)%X=PLB(IIB:IIE,IJB:IJE,:)
- CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,IERR)
- END IF
- IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- DEALLOCATE(T_TX3DP(1)%X)
- END IF
- DEALLOCATE(T_TX3DP,REQ_TAB)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- END IF !(GSMONOPROC)
- ELSE
- IRESP = -61
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_LB','file '//TRIM(TPFILE%CNAME)//' not found')
- END IF
- !----------------------------------------------------------------
-1000 CONTINUE
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_LB',YMSG)
- END IF
- !
- IF (ALLOCATED(Z3D)) DEALLOCATE(Z3D)
- IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_WRITE_FIELD_BYFIELD_LB
-
- SUBROUTINE FMWRITBOXX2_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_GATHER_ll
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:),TARGET, INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITBOXX2_ll','writing '//TRIM(HRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article BOXX2 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX)
- ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
- END IF
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- ! Allocate the box
- ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1))
- GALLOC = .TRUE.
- ELSE
- ALLOCATE(ZFIELDP(0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- END IF ! multiprocessor execution
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITBOXX2_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITBOXX2_ll
-
- SUBROUTINE FMWRITBOXX3_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_GATHER_ll
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITBOXX3_ll','writing '//TRIM(HRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article BOXX3 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:)
- ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
- END IF
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- ! Allocate the box
- ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3)))
- GALLOC = .TRUE.
- ELSE
- ALLOCATE(ZFIELDP(0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- END IF ! multiprocessor execution
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITBOXX3_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITBOXX3_ll
-
- SUBROUTINE FMWRITBOXX4_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_GATHER_ll
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITBOXX4_ll','writing '//TRIM(HRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article BOXX4 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:)
- ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
- END IF
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- ! Allocate the box
- ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),SIZE(PFIELD,4)))
- GALLOC = .TRUE.
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,TFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,TFIELD,IRESP)
+ ELSE
IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,TFIELD,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,TFIELD,IRESP)
END IF
!
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- END IF ! multiprocessor execution
- ELSE
+ CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD%COMM,IERR)
+ END IF
+ ELSE
IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_T0','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITBOXX4_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
+ WRITE(YRESP, '( I6 )') IRESP
+ YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_T0',YMSG)
END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITBOXX4_ll
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_T0
- SUBROUTINE FMWRITBOXX5_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_GATHER_ll
+
+ SUBROUTINE IO_WRITE_FIELD_BYNAME_LB(TPFILE,HNAME,KL3D,PLB,KRESP)
!
+ USE MODD_IO_ll, ONLY : TFILEDATA
!
!* 0.1 Declarations of arguments
!
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ INTEGER, INTENT(IN) :: KL3D ! size of the LB array in FM
+ REAL,DIMENSION(:,:,:), INTENT(IN) :: PLB ! array containing the LB field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
!
!* 0.2 Declarations of local variables
!
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
+ INTEGER :: ID ! Index of the field
+ INTEGER :: IRESP ! return_code
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYNAME_LB',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+ !
+ IF(IRESP==0) CALL IO_WRITE_FIELD_LB(TPFILE,TFIELDLIST(ID),KL3D,PLB,IRESP)
+ !
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ !
+ END SUBROUTINE IO_WRITE_FIELD_BYNAME_LB
+
+ SUBROUTINE IO_WRITE_FIELD_BYFIELD_LB(TPFILE,TPFIELD,KL3D,PLB,KRESP)
+ !
+ USE MODD_IO_ll
+ USE MODD_PARAMETERS_ll,ONLY : JPHEXT
+ USE MODE_DISTRIB_LB
+ USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll
+ USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_ll
+ !
+ USE MODD_VAR_ll, ONLY : MNH_STATUSES_IGNORE
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+ INTEGER, INTENT(IN) :: KL3D ! size of the LB array in FM
+ REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: PLB ! array containing the LB field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ CHARACTER(LEN=28) :: YFILEM ! FM-file name
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
+ CHARACTER(LEN=4) :: YLBTYPE ! 'LBX','LBXU','LBY' or 'LBYV'
+ CHARACTER(LEN=JPFINL) :: YFNLFI
+ INTEGER :: IRIM ! size of the LB area
+ INTEGER :: IERR
+ TYPE(FD_ll), POINTER :: TZFD
+ INTEGER :: IRESP
+ REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
+ REAL,DIMENSION(:,:,:), POINTER :: TX3DP
+ INTEGER :: IIMAX_ll,IJMAX_ll
+ INTEGER :: JI
+ INTEGER :: IIB,IIE,IJB,IJE
+ INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
+ INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
+ INTEGER :: NB_REQ,IKU
+ TYPE TX_3DP
+ REAL,DIMENSION(:,:,:), POINTER :: X
+ END TYPE TX_3DP
+ TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ !
+ YFILEM = TPFILE%CNAME
+ YRECFM = TPFIELD%CMNHNAME
+ YLBTYPE = TPFIELD%CLBTYPE
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_WRITE_FIELD_BYFIELD_LB',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ !
+ IF (YLBTYPE/='LBX' .AND. YLBTYPE/='LBXU' .AND. YLBTYPE/='LBY' .AND. YLBTYPE/='LBYV') THEN
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_LB','unknown LBTYPE ('//YLBTYPE//')')
+ RETURN
+ END IF
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITBOXX5_ll','writing '//TRIM(HRECFM))
+ IF (TPFIELD%CDIR/='XY') THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_WRITE_FIELD_BYFIELD_LB','CDIR was not set to "XY" for '//TRIM(YRECFM))
+ TPFIELD%CDIR='XY'
+ END IF
!
!* 1.1 THE NAME OF LFIFM
!
IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article BOXX5 ' , HRECFM
- !------------------------------------------------------------------
+ YFNLFI=TRIM(ADJUSTL(YFILEM))//'.lfi'
+ !
+ IRIM = (KL3D-2*JPHEXT)/2
+ IF (KL3D /= 2*(IRIM+JPHEXT)) THEN
+ IRESP = -30
+ GOTO 1000
+ END IF
+ !
TZFD=>GETFD(YFNLFI)
IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:,:)
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (LPACK .AND. L2D) THEN
+ TX3DP=>PLB(:,JPHEXT+1:JPHEXT+1,:)
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,TX3DP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,TX3DP,IRESP)
ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,PLB,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,PLB,IRESP)
END IF
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
- ELSE ! multiprocessor execution
+ ELSE
IF (ISP == TZFD%OWNER) THEN
- ! Allocate the box
- ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),&
- & SIZE(PFIELD,4),SIZE(PFIELD,5)))
- GALLOC = .TRUE.
+ ! I/O proc case
+ CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
+ IF (YLBTYPE == 'LBX' .OR. YLBTYPE == 'LBXU') THEN
+ ALLOCATE(Z3D((IRIM+JPHEXT)*2,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
+ ELSE ! YLBTYPE == 'LBY' .OR. YLBTYPE == 'LBYV'
+ ALLOCATE(Z3D(IIMAX_ll+2*JPHEXT,(IRIM+JPHEXT)*2,SIZE(PLB,3)))
+ END IF
+ DO JI = 1,ISNPROC
+ CALL GET_DISTRIB_LB(YLBTYPE,JI,'FM','WRITE',IRIM,IIB,IIE,IJB,IJE)
+ IF (IIB /= 0) THEN
+ TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
+ IF (ISP /= JI) THEN
+ CALL MPI_RECV(TX3DP,SIZE(TX3DP),MPI_FLOAT,JI-1,99,TZFD%COMM,STATUS,IERR)
+ ELSE
+ CALL GET_DISTRIB_LB(YLBTYPE,JI,'LOC','WRITE',IRIM,IIB,IIE,IJB,IJE)
+ TX3DP = PLB(IIB:IIE,IJB:IJE,:)
+ END IF
+ END IF
+ END DO
+ IF (LPACK .AND. L2D) THEN
+ TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
+ ELSE
+ TX3DP=>Z3D
+ END IF
+ IF (LLFIOUT) CALL IO_WRITE_FIELD_LFI(TPFIELD,TZFD%FLU,TX3DP,IRESP)
+ IF (LIOCDF4) CALL IO_WRITE_FIELD_NC4(TPFILE,TPFIELD,TZFD%CDF,TX3DP,IRESP)
ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
+ NB_REQ=0
+ ALLOCATE(REQ_TAB(1))
+ ALLOCATE(T_TX3DP(1))
+ IKU = SIZE(PLB,3)
+ ! Other processors
+ CALL GET_DISTRIB_LB(YLBTYPE,ISP,'LOC','WRITE',IRIM,IIB,IIE,IJB,IJE)
+ IF (IIB /= 0) THEN
+ TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
+ NB_REQ = NB_REQ + 1
+ ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
+ T_TX3DP(NB_REQ)%X=PLB(IIB:IIE,IJB:IJE,:)
+ CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,REQ_TAB(NB_REQ),IERR)
+ !CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MPI_FLOAT,TZFD%OWNER-1,99,TZFD%COMM,IERR)
+ END IF
+ IF (NB_REQ .GT.0 ) THEN
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ DEALLOCATE(T_TX3DP(1)%X)
+ END IF
+ DEALLOCATE(T_TX3DP,REQ_TAB)
END IF
!
CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
& %COMM,IERR)
- END IF ! multiprocessor execution
+ END IF !(GSMONOPROC)
ELSE
IRESP = -61
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_LB','file '//TRIM(TPFILE%CNAME)//' not found')
END IF
!----------------------------------------------------------------
+1000 CONTINUE
IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITBOXX5_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
+ WRITE(YRESP, '( I6 )') IRESP
+ YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
+ CALL PRINT_MSG(NVERB_ERROR,'IO','IO_WRITE_FIELD_BYFIELD_LB',YMSG)
END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITBOXX5_ll
+ !
+ IF (ALLOCATED(Z3D)) DEALLOCATE(Z3D)
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ END SUBROUTINE IO_WRITE_FIELD_BYFIELD_LB
+
SUBROUTINE IO_WRITE_FIELD_BOX_BYFIELD_X5(TPFILE,TPFIELD,HBUDGET,PFIELD,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
!
USE MODD_IO_ll
- USE MODD_FM
USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
USE MODE_GATHER_ll
!
@@ -5146,99 +2897,4 @@ CONTAINS
IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_BOX_BYFIELD_X5
- SUBROUTINE FMWRITBOXX6_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- USE MODD_IO_ll, ONLY : ISP,GSMONOPROC,LIOCDF4,LLFIOUT
- USE MODD_FM
- USE MODE_FD_ll, ONLY : GETFD,JPFINL,FD_LL
- USE MODE_GATHER_ll
- !
- !
- !* 0.1 Declarations of arguments
- !
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- !
- !* 0.2 Declarations of local variables
- !
- CHARACTER(LEN=JPFINL) :: YFNLFI
- INTEGER :: IERR
- TYPE(FD_ll), POINTER :: TZFD
- INTEGER :: IRESP
- REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
- TYPE(FMHEADER) :: TZFMH
- LOGICAL :: GALLOC
-
- !
- CALL PRINT_MSG(NVERB_DEBUG,'IO','FMWRITBOXX6_ll','writing '//TRIM(HRECFM))
- !
- !* 1.1 THE NAME OF LFIFM
- !
- IRESP = 0
- GALLOC = .FALSE.
- YFNLFI=TRIM(ADJUSTL(HFILEM))//'.lfi'
- !print * , ' Writing Article BOXX6 ' , HRECFM
- !------------------------------------------------------------------
- TZFD=>GETFD(YFNLFI)
- IF (ASSOCIATED(TZFD)) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (HBUDGET /= 'BUDGET') THEN
- ! take the sub-section of PFIELD defined by the box
- ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:,:,:)
- ELSE
- ! take the field as a budget
- ZFIELDP=>PFIELD
- END IF
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
- ELSE ! multiprocessor execution
- IF (ISP == TZFD%OWNER) THEN
- ! Allocate the box
- ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),&
- & SIZE(PFIELD,4),SIZE(PFIELD,5),SIZE(PFIELD,6)))
- GALLOC = .TRUE.
- ELSE
- ALLOCATE(ZFIELDP(0,0,0,0,0,0))
- GALLOC = .TRUE.
- END IF
- !
- CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TZFD%OWNER,TZFD%COMM,&
- & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
- !
- IF (ISP == TZFD%OWNER) THEN
- TZFMH%GRID = KGRID
- TZFMH%COMLEN = LEN_TRIM(HCOMMENT)
- TZFMH%COMMENT = HCOMMENT
- IF (LLFIOUT) CALL FM_WRIT_ll(TZFD%FLU,HRECFM,.TRUE.,SIZE(ZFIELDP),ZFIELDP,TZFMH&
- & ,IRESP)
- IF (LIOCDF4) CALL NCWRIT(TZFD%CDF,HRECFM,'XY',ZFIELDP,TZFMH,IRESP)
- END IF
- !
- CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TZFD%OWNER-1,TZFD&
- & %COMM,IERR)
- END IF ! multiprocessor execution
- ELSE
- IRESP = -61
- END IF
- !----------------------------------------------------------------
- IF (IRESP.NE.0) THEN
- CALL FM_WRIT_ERR("FMWRITBOXX6_ll",HFILEM,HFIPRI,HRECFM,'XY',KGRID,LEN(HCOMMENT),IRESP)
- END IF
- IF (GALLOC) DEALLOCATE(ZFIELDP)
- KRESP = IRESP
- END SUBROUTINE FMWRITBOXX6_ll
-
END MODULE MODE_FMWRIT
diff --git a/src/LIB/SURCOUCHE/src/mode_netcdf.f90 b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
index 9064e152b..4806eedfd 100644
--- a/src/LIB/SURCOUCHE/src/mode_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/mode_netcdf.f90
@@ -46,24 +46,10 @@ INTERFACE IO_READ_FIELD_NC4
IO_READ_FIELD_NC4_T0
END INTERFACE IO_READ_FIELD_NC4
-INTERFACE NCWRIT
- MODULE PROCEDURE NCWRITX0, NCWRITX1, NCWRITX2, NCWRITX3, &
- & NCWRITX4, NCWRITX5, NCWRITX6, &
- & NCWRITN0, NCWRITN1, NCWRITN2, &
- & NCWRITC0, NCWRITC1
-END INTERFACE NCWRIT
-
-INTERFACE NCREAD
- MODULE PROCEDURE NCREADX0, NCREADX1, NCREADX2, NCREADX3, &
- & NCREADX4, NCREADX5, NCREADX6, &
- & NCREADN0, NCREADN1, NCREADN2, &
- & NCREADC0
-END INTERFACE NCREAD
-
! Public from module netcdf
PUBLIC NF90_OPEN,NF90_CREATE,NF90_NOWRITE,NF90_CLOBBER,NF90_NETCDF4,NF90_NOERR,NF90_STRERROR
! Public from this module :
-PUBLIC NEWIOCDF,CLEANIOCDF,NCWRIT,NCREAD,IO_WRITE_FIELD_NC4,IO_READ_FIELD_NC4,IO_WRITE_HEADER_NC4
+PUBLIC NEWIOCDF,CLEANIOCDF,IO_WRITE_FIELD_NC4,IO_READ_FIELD_NC4,IO_WRITE_HEADER_NC4
CONTAINS
@@ -209,23 +195,6 @@ END IF
!
END SUBROUTINE IO_WRITE_HEADER_NC4
-SUBROUTINE WRITATTR(KNCID, KVARID, TPFMH)
-USE MODD_FM, ONLY : FMHEADER
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KVARID
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-
-! GRID attribute definition
-STATUS = NF90_PUT_ATT(KNCID, KVARID, 'GRID', TPFMH%GRID)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITATTR [NF90_PUT_ATT]')
-
-! COMMENT attribute definition
-STATUS = NF90_PUT_ATT(KNCID, KVARID,'COMMENT', TRIM(TPFMH%COMMENT))
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'WRITATTR [NF90_PUT_ATT]')
-
-END SUBROUTINE WRITATTR
SUBROUTINE IO_WRITE_FIELD_ATTR_NC4(TPFIELD,KNCID,KVARID,HCALENDAR)
!
@@ -450,47 +419,6 @@ END DO
END SUBROUTINE FILLVDIMS
-SUBROUTINE NCWRITX0(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-REAL, INTENT(IN) :: PFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITX0','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Define the scalar variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVARID)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX0[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITX0 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX0[NF90_PUT_VAR]',IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITX0
-
SUBROUTINE IO_WRITE_FIELD_NC4_X0(TPFILE,TPFIELD,PZCDF,PFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -532,50 +460,6 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X0
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_X0
-SUBROUTINE NCWRITX1(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-REAL, DIMENSION(:), INTENT(IN) :: PFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITX1','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions
- CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX1[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITX1 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX1[NF90_PUT_VAR]',IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITX1
SUBROUTINE IO_WRITE_FIELD_NC4_X1(TPFILE,TPFIELD,PZCDF,PFIELD,KRESP)
!
@@ -637,50 +521,6 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X1
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_X1
-SUBROUTINE NCWRITX2(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITX2','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions
- CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX2[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITX2 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX2[NF90_PUT_VAR]',IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITX2
SUBROUTINE IO_WRITE_FIELD_NC4_X2(TPFILE,TPFIELD,PZCDF,PFIELD,KRESP,KVERTLEVEL,KZFILE)
!
@@ -769,50 +609,6 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X2
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_X2
-SUBROUTINE NCWRITX3(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-REAL, DIMENSION(:,:,:),INTENT(IN) :: PFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITX3','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions
- CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX3[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITX3 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX3[NF90_PUT_VAR] '//TRIM(HVARNAME),IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITX3
SUBROUTINE IO_WRITE_FIELD_NC4_X3(TPFILE,TPFIELD,PZCDF,PFIELD,KRESP)
!
@@ -875,50 +671,6 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X3
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_X3
-SUBROUTINE NCWRITX4(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITX4','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions
- CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX4[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITX4 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX4[NF90_PUT_VAR]',IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITX4
SUBROUTINE IO_WRITE_FIELD_NC4_X4(TPFILE,TPFIELD,PZCDF,PFIELD,KRESP)
!
@@ -981,50 +733,6 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X4
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_X4
-SUBROUTINE NCWRITX5(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-REAL, DIMENSION(:,:,:,:,:), INTENT(IN) :: PFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITX5','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions
- CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX5[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITX5 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX5[NF90_PUT_VAR]',IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITX5
SUBROUTINE IO_WRITE_FIELD_NC4_X5(TPFILE,TPFIELD,PZCDF,PFIELD,KRESP)
!
@@ -1087,50 +795,6 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X5
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_X5
-SUBROUTINE NCWRITX6(PZCDF, HVARNAME, HDIR, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITX6','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions
- CALL FILLVDIMS(PZCDF, INT(SHAPE(PFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_DOUBLE, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX6[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITX6 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITX6[NF90_PUT_VAR]',IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITX6
SUBROUTINE IO_WRITE_FIELD_NC4_X6(TPFILE,TPFIELD,PZCDF,PFIELD,KRESP)
!
@@ -1193,67 +857,6 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_X6
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_X6
-SUBROUTINE NCWRITN0(PZCDF, HVARNAME, HDIR, KFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-USE MODD_PARAMETERS_ll, ONLY : JPHEXT, JPVEXT
-USE MODD_IO_ll, ONLY : LPACK,L1D,L2D
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-INTEGER, INTENT(IN) :: KFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITN0','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Define the scalar variable
-#ifndef MNH_INT8
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN0[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITN0 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, KFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN0[NF90_PUT_VAR]',IRESP)
-!
-! Use IMAX, JMAX, KMAX to define DIMX, DIMY, DIMZ
-! /!\ Can only work if IMAX, JMAX or KMAX are written before any array
-!
-#if 0
-IF (YVARNAME == 'IMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMX)) PZCDF%DIMX=>GETDIMCDF(PZCDF,KFIELD+2*JPHEXT,'X')
-IF (YVARNAME == 'JMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMY)) THEN
- IF (LPACK .AND. L2D) THEN
- PZCDF%DIMY=>GETDIMCDF(PZCDF, 1,'Y')
- ELSE
- PZCDF%DIMY=>GETDIMCDF(PZCDF, KFIELD+2*JPHEXT, 'Y')
- END IF
-END IF
-#endif
-IF (YVARNAME == 'KMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMZ)) PZCDF%DIMZ=>GETDIMCDF(PZCDF,INT(KFIELD+2*JPVEXT,KIND=IDCDF_KIND),'Z')
-
-KRESP = IRESP
-END SUBROUTINE NCWRITN0
SUBROUTINE IO_WRITE_FIELD_NC4_N0(TPFILE,TPFIELD,PZCDF,KFIELD,KRESP)
!
@@ -1322,53 +925,6 @@ IF (YVARNAME == 'KMAX' .AND. .NOT. ASSOCIATED(PZCDF%DIMZ)) PZCDF%DIMZ=>GETDIMCDF
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_N0
-SUBROUTINE NCWRITN1(PZCDF, HVARNAME, HDIR, KFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-INTEGER, DIMENSION(:), INTENT(IN) :: KFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(KFIELD))) :: IVDIMS
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITN1','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions
- CALL FILLVDIMS(PZCDF, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
- ! Define the variable
-#ifndef MNH_INT8
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVDIMS, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN1[NF90_DEF_VAR] '//TRIM(YVARNAME))
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITN1 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, KFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN1[NF90_PUT_VAR]',IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITN1
SUBROUTINE IO_WRITE_FIELD_NC4_N1(TPFILE,TPFIELD,PZCDF,KFIELD,KRESP)
!
@@ -1431,54 +987,6 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_N1
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_N1
-SUBROUTINE NCWRITN2(PZCDF, HVARNAME, HDIR, KFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-INTEGER, DIMENSION(:,:),INTENT(IN) :: KFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(KFIELD))) :: IVDIMS
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITN2','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions
- CALL FILLVDIMS(PZCDF, INT(SHAPE(KFIELD),KIND=IDCDF_KIND), HDIR, IVDIMS)
-
- ! Define the variable
-#ifndef MNH_INT8
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT, IVDIMS, IVARID)
-#else
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT64, IVDIMS, IVARID)
-#endif
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN2[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITN2 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, KFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITN2[NF90_PUT_VAR]',IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITN2
SUBROUTINE IO_WRITE_FIELD_NC4_N2(TPFILE,TPFIELD,PZCDF,KFIELD,KRESP)
!
@@ -1716,56 +1224,6 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_L1
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_L1
-SUBROUTINE NCWRITC0(PZCDF, HVARNAME, HDIR, HFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-CHARACTER(LEN=*), INTENT(IN) :: HFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(1) :: IVDIMS
-CHARACTER(LEN=32) :: YSTR
-!CHARACTER(LEN=LEN(HFIELD)) :: YSTR
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITC0','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-YSTR = HFIELD
-IF (LEN_TRIM(HFIELD) > LEN(YSTR)) THEN
- PRINT *,'NCWRITC0 : ',TRIM(YVARNAME), ' string variable TRUNCATED.'
-END IF
-
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf string dimensions id
- IVDIMS(1) = GETSTRDIMID(PZCDF, INT(LEN(YSTR),KIND=IDCDF_KIND))
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_CHAR, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITC0[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITC0 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, YSTR)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITC0[NF90_PUT_VAR]',IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITC0
SUBROUTINE IO_WRITE_FIELD_NC4_C0(TPFILE,TPFIELD,PZCDF,HFIELD,KRESP)
!
@@ -1877,57 +1335,6 @@ IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_WRITE_FIELD_NC4_C1
KRESP = IRESP
END SUBROUTINE IO_WRITE_FIELD_NC4_C1
-SUBROUTINE NCWRITC1(PZCDF, HVARNAME, HDIR, HFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER
-TYPE(IOCDF), POINTER :: PZCDF
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(IN) :: HDIR
-CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HFIELD
-TYPE(FMHEADER), INTENT(IN) :: TPFMH
-INTEGER, INTENT(OUT):: KRESP
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: INCID
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND), DIMENSION(2) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND), DIMENSION(1) :: ITMP
-INTEGER :: IRESP
-INTEGER(KIND=IDCDF_KIND) :: ILEN
-INTEGER(KIND=IDCDF_KIND) :: ISIZE
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCWRITC1','writing '//TRIM(HVARNAME))
-
-IRESP = 0
-ILEN = LEN(HFIELD)
-ISIZE = SIZE(HFIELD)
-
-! Get the Netcdf file ID
-INCID = PZCDF%NCID
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions ID
- IVDIMS(1) = GETSTRDIMID(PZCDF,ILEN)
- CALL FILLVDIMS(PZCDF, (/ISIZE/), HDIR, ITMP)
- IVDIMS(2) = ITMP(1)
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_CHAR, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITC1[NF90_DEF_VAR]')
- CALL WRITATTR(INCID, IVARID, TPFMH)
-ELSE
- PRINT *,'NCWRITC1 : ', TRIM(YVARNAME), ' already defined !'
-END IF
-
-! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, HFIELD)
-IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCWRITC1[NF90_PUT_VAR]',IRESP)
-
-KRESP = IRESP
-END SUBROUTINE NCWRITC1
SUBROUTINE IO_WRITE_FIELD_NC4_T0(TPFILE,TPFIELD,PZCDF,TPDATA,KRESP)
!
@@ -2053,35 +1460,6 @@ END SUBROUTINE IO_WRITE_FIELD_NC4_T0
! Here come the NetCDF READ routines
!
!
-SUBROUTINE READATTR(KNCID, KVARID, HVAR, TPFMH)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KVARID
-CHARACTER(LEN=*),INTENT(IN) :: HVAR
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN
-
-! Read variables attributes (GRID and COMMENT)
-STATUS = NF90_GET_ATT(KNCID, KVARID, 'GRID', TPFMH%GRID)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'READATTR[NF90_GET_ATT_INT] '//TRIM(HVAR))
-STATUS = NF90_INQUIRE_ATTRIBUTE(KNCID, KVARID, 'COMMENT', LEN=ICOMLEN)
-!IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'READATTR[NF90_INQUIRE_ATTRIBUTE] '//TRIM(HVAR))
-IF (STATUS == NF90_NOERR) THEN
- IF (ICOMLEN <= JPXKRK) THEN
- TPFMH%COMLEN = ICOMLEN
- STATUS = NF90_GET_ATT(KNCID, KVARID, 'COMMENT', TPFMH%COMMENT)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'READATTR[NF90_GET_ATT] '//TRIM(HVAR))
- ELSE
- PRINT *, 'READATTR : '//TRIM(HVAR)//' COMMENT attribute ignored because too long.'
- TPFMH%COMLEN = 0
- END IF
-ELSE
- TPFMH%COMLEN = 0
-END IF
-END SUBROUTINE READATTR
-
SUBROUTINE IO_READ_CHECK_FIELD_ATTR_NC4(TPFIELD,KNCID,KVARID,KRESP,HCALENDAR)
!
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -2264,56 +1642,6 @@ ENDIF
END SUBROUTINE IO_READ_CHECK_FIELD_ATTR_NC4
-SUBROUTINE NCREADX0(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-REAL, INTENT(OUT):: PFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADX0','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-IF (IDIMS == 0 .AND. ITYPE == NF90_DOUBLE) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
-ELSE
- PRINT *, 'NCREADNCREADX0 : '//TRIM(YVARNAME)//' not READ (wrong size or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADX0
-
SUBROUTINE IO_READ_FIELD_NC4_X0(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -2365,72 +1693,6 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_X0
-SUBROUTINE NCREADX1(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-REAL, DIMENSION(:), INTENT(OUT):: PFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER :: IVARSIZE
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: II
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADX1','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX1[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX1[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF90_DOUBLE) THEN
- ! Check size of variable before reading
- IVARSIZE = 1
- DO II=1,IDIMS
- STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(II), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX1[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IVARSIZE = IVARSIZE*IDIMLEN
- END DO
-
- IF (IVARSIZE == SIZE(PFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX1[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
- ELSE
- PRINT *, 'NCREADX1 : '//TRIM(YVARNAME)//' not READ wrong size (file, mem) : ', IVARSIZE, SIZE(PFIELD)
- IRESP = -3
- END IF
-ELSE
- PRINT *, 'NCREADX1 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADX1
SUBROUTINE IO_READ_FIELD_NC4_X1(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -2495,86 +1757,6 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_X1
-SUBROUTINE NCREADX2(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-REAL, DIMENSION(:,:), INTENT(OUT):: PFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-!INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND), DIMENSION(3) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER :: IVARSIZE
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: II
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADX2','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX2[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX2[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!Treat special case of a degenerated 3D array (3rd dimension size is 1)
-IF (IDIMS==3) THEN
- STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(3), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IF (IDIMLEN==1) THEN
- CALL PRINT_MSG(NVERB_INFO,'IO','NCREADX2','reading 3D array with degenerated third dimension in 2D array for '//TRIM(HVARNAME))
- IDIMS = 2
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','NCREADX2','wrong number of dimensions for '//TRIM(HVARNAME))
- END IF
-END IF
-
-IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF90_DOUBLE) THEN
- ! Check size of variable before reading
- IVARSIZE = 1
- DO II=1,IDIMS
- STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(II), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IVARSIZE = IVARSIZE*IDIMLEN
- END DO
-
- IF (IVARSIZE == SIZE(PFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX2[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
- ELSE
- PRINT *, 'NCREADX2 : '//TRIM(YVARNAME)//' not READ (wrong size).'
- IRESP = -3
- END IF
-ELSE
- PRINT *, 'NCREADX2 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADX2
SUBROUTINE IO_READ_FIELD_NC4_X2(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -2654,72 +1836,6 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_X2
-SUBROUTINE NCREADX3(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-REAL, DIMENSION(:,:,:), INTENT(OUT):: PFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER :: IVARSIZE
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: II
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADX3','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX3[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX3[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF90_DOUBLE) THEN
- ! Check size of variable before reading
- IVARSIZE = 1
- DO II=1,IDIMS
- STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(II), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX3[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IVARSIZE = IVARSIZE*IDIMLEN
- END DO
-
- IF (IVARSIZE == SIZE(PFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX3[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
- ELSE
- PRINT *, 'NCREADX3 : '//TRIM(YVARNAME)//' not READ (wrong size).'
- IRESP = -3
- END IF
-ELSE
- PRINT *, 'NCREADX3 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADX3
SUBROUTINE IO_READ_FIELD_NC4_X3(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -2788,72 +1904,6 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_X3
-SUBROUTINE NCREADX4(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-REAL, DIMENSION(:,:,:,:), INTENT(OUT):: PFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER :: IVARSIZE
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: II
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADX4','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX4[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX4[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF90_DOUBLE) THEN
- ! Check size of variable before reading
- IVARSIZE = 1
- DO II=1,IDIMS
- STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(II), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX4[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IVARSIZE = IVARSIZE*IDIMLEN
- END DO
-
- IF (IVARSIZE == SIZE(PFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX4[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
- ELSE
- PRINT *, 'NCREADX4 : '//TRIM(YVARNAME)//' not READ (wrong size).'
- IRESP = -3
- END IF
-ELSE
- PRINT *, 'NCREADX4 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADX4
SUBROUTINE IO_READ_FIELD_NC4_X4(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -2925,72 +1975,6 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_X4
-SUBROUTINE NCREADX5(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-REAL, DIMENSION(:,:,:,:,:), INTENT(OUT):: PFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER :: IVARSIZE
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: II
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADX5','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX5[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX5[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF90_DOUBLE) THEN
- ! Check size of variable before reading
- IVARSIZE = 1
- DO II=1,IDIMS
- STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(II), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX5[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IVARSIZE = IVARSIZE*IDIMLEN
- END DO
-
- IF (IVARSIZE == SIZE(PFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX5[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
- ELSE
- PRINT *, 'NCREADX5 : '//TRIM(YVARNAME)//' not READ (wrong size).'
- IRESP = -3
- END IF
-ELSE
- PRINT *, 'NCREADX5 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADX5
SUBROUTINE IO_READ_FIELD_NC4_X5(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -3065,72 +2049,6 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_X5
-SUBROUTINE NCREADX6(KNCID, HVARNAME, PFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND), INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-REAL, DIMENSION(:,:,:,:,:,:), INTENT(OUT):: PFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND), DIMENSION(SIZE(SHAPE(PFIELD))) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER :: IVARSIZE
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: II
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADX6','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX6[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADX6[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-IF (IDIMS == SIZE(SHAPE(PFIELD)) .AND. ITYPE == NF90_DOUBLE) THEN
- ! Check size of variable before reading
- IVARSIZE = 1
- DO II=1,IDIMS
- STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(II), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADX6[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IVARSIZE = IVARSIZE*IDIMLEN
- END DO
-
- IF (IVARSIZE == SIZE(PFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADX6[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
- ELSE
- PRINT *, 'NCREADX6 : '//TRIM(YVARNAME)//' not READ (wrong size).'
- IRESP = -3
- END IF
-ELSE
- PRINT *, 'NCREADX6 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADX6
SUBROUTINE IO_READ_FIELD_NC4_X6(TPFILE, TPFIELD, PFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -3207,60 +2125,6 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_X6
-SUBROUTINE NCREADN0(KNCID, HVARNAME, KFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-INTEGER, INTENT(OUT):: KFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADN0','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADN0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADN0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!NF90_INT1 is for the case a boolean was written
-#ifndef MNH_INT8
-IF (IDIMS == 0 .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT1) ) THEN
-#else
-IF (IDIMS == 0 .AND. (ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
-#endif
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, KFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADN0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
-ELSE
- PRINT *, 'NCREADN0 : '//TRIM(YVARNAME)//' not READ (wrong size or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADN0
SUBROUTINE IO_READ_FIELD_NC4_N0(TPFILE, TPFIELD, KFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -3318,77 +2182,6 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_N0
-SUBROUTINE NCREADN1(KNCID, HVARNAME, KFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-INTEGER, DIMENSION(:), INTENT(OUT):: KFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(SIZE(SHAPE(KFIELD))) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER :: IVARSIZE
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: II
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADN1','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADN1[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADN1[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!NF90_INT1 is for the case a boolean was written
-#ifndef MNH_INT8
-IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT1) ) THEN
-#else
-IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
-#endif
- ! Check size of variable before reading
- IVARSIZE = 1
- DO II=1,IDIMS
- STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(II), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADN1[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IVARSIZE = IVARSIZE*IDIMLEN
- END DO
-
- IF (IVARSIZE == SIZE(KFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, KFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADN1[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
- ELSE
- PRINT *, 'NCREADN1 : '//TRIM(YVARNAME)//' not READ (wrong size).'
- IRESP = -3
- END IF
-ELSE
- PRINT *, 'NCREADN1 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADN1
SUBROUTINE IO_READ_FIELD_NC4_N1(TPFILE, TPFIELD, KFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -3458,77 +2251,6 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_N1
-SUBROUTINE NCREADN2(KNCID, HVARNAME, KFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-INTEGER, DIMENSION(:,:), INTENT(OUT):: KFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(SIZE(SHAPE(KFIELD))) :: IVDIMS
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER :: IVARSIZE
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: II
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADN2','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADN2[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADN2[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-!NF90_INT1 is for the case a boolean was written
-#ifndef MNH_INT8
-IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT1) ) THEN
-#else
-IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
-#endif
- ! Check size of variable before reading
- IVARSIZE = 1
- DO II=1,IDIMS
- STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(II), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADN2[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- IVARSIZE = IVARSIZE*IDIMLEN
- END DO
-
- IF (IVARSIZE == SIZE(KFIELD)) THEN
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, KFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADN2[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
- ELSE
- PRINT *, 'NCREADN2 : '//TRIM(YVARNAME)//' not READ (wrong size).'
- IRESP = -3
- END IF
-ELSE
- PRINT *, 'NCREADN2 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADN2
SUBROUTINE IO_READ_FIELD_NC4_N2(TPFILE, TPFIELD, KFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -3764,68 +2486,6 @@ KRESP = IRESP
END SUBROUTINE IO_READ_FIELD_NC4_L1
-SUBROUTINE NCREADC0(KNCID, HVARNAME, HFIELD, TPFMH, KRESP)
-USE MODD_FM, ONLY : FMHEADER, JPXKRK
-INTEGER(KIND=IDCDF_KIND),INTENT(IN) :: KNCID
-CHARACTER(LEN=*), INTENT(IN) :: HVARNAME
-CHARACTER(LEN=*), INTENT(OUT):: HFIELD
-TYPE(FMHEADER), INTENT(OUT):: TPFMH
-INTEGER, INTENT(OUT):: KRESP ! return-code
-
-INTEGER(KIND=IDCDF_KIND) :: STATUS
-CHARACTER(LEN=30) :: YVARNAME
-INTEGER(KIND=IDCDF_KIND) :: IVARID
-INTEGER(KIND=IDCDF_KIND) :: ITYPE ! variable type
-INTEGER(KIND=IDCDF_KIND) :: IDIMS ! number of dimensions
-INTEGER(KIND=IDCDF_KIND),DIMENSION(1) :: IVDIMS
-CHARACTER(LEN=:),ALLOCATABLE :: YSTR
-INTEGER(KIND=IDCDF_KIND) :: ICOMLEN ! comment length
-INTEGER(KIND=IDCDF_KIND) :: IDIMLEN
-INTEGER :: II
-INTEGER :: IRESP
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','NCREADC0','reading '//TRIM(HVARNAME))
-
-IRESP = 0
-
-CALL CLEANMNHNAME(HVARNAME,YVARNAME)
-
-! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(KNCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF90_INQ_VARID] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
-END IF
-STATUS = NF90_INQUIRE_VARIABLE(KNCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'NCREADC0[NF90_INQUIRE_VARIABLE] '//TRIM(YVARNAME))
-
-IF (IDIMS == 1 .AND. ITYPE == NF90_CHAR) THEN
- ! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(KNCID, IVDIMS(1), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
- !
- ALLOCATE(CHARACTER(LEN=IDIMLEN)::YSTR)
- ! Read variable
- STATUS = NF90_GET_VAR(KNCID, IVARID, YSTR)
- IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
- GOTO 1000
- END IF
- IF (LEN_TRIM(YSTR) > LEN(HFIELD)) PRINT *, 'NCDREADC0 : '//TRIM(YVARNAME)//' truncated !!'
- HFIELD = TRIM(YSTR)
- DEALLOCATE(YSTR)
- ! Read variables attributes (GRID and COMMENT)
- CALL READATTR(KNCID, IVARID, YVARNAME, TPFMH)
-ELSE
- PRINT *, 'NCREADC0 : '//TRIM(YVARNAME)//' not READ (wrong shape or type).'
- IRESP = -3
-END IF
-
-1000 CONTINUE
-KRESP = IRESP
-
-END SUBROUTINE NCREADC0
-
SUBROUTINE IO_READ_FIELD_NC4_C0(TPFILE, TPFIELD, HFIELD, KRESP)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -3863,13 +2523,13 @@ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(STATUS,__LINE__,'IO_READ_FIELD_NC4_C0[
IF (IDIMS == 1 .AND. (ITYPE == NF90_CHAR) ) THEN
! Check size of variable before reading
STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
+ IF (STATUS /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_C0[NF90_INQUIRE_DIMENSION] '//TRIM(YVARNAME))
!
ALLOCATE(CHARACTER(LEN=IDIMLEN)::YSTR)
! Read variable
STATUS = NF90_GET_VAR(INCID, IVARID, YSTR)
IF (STATUS /= NF90_NOERR) THEN
- CALL HANDLE_ERR(status,__LINE__,'NCREADC0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
+ CALL HANDLE_ERR(status,__LINE__,'IO_READ_FIELD_NC4_C0[NF90_GET_VAR] '//TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
IF (LEN_TRIM(YSTR) > LEN(HFIELD)) &
@@ -3968,21 +2628,16 @@ INTEGER :: A,B,C,D
PRINT *, 'IO_WRITE_FIELD_NC4 empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
END SUBROUTINE IO_WRITE_FIELD_NC4
+SUBROUTINE IO_READ_FIELD_NC4(A,B,C,D)
+INTEGER :: A,B,C,D
+PRINT *, 'IO_READ_FIELD_NC4 empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
+END SUBROUTINE IO_READ_FIELD_NC4
+
SUBROUTINE IO_WRITE_HEADER_NC4(A,B)
INTEGER :: A,B
PRINT *, 'IO_WRITE_HEADER_NC4 empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
END SUBROUTINE IO_WRITE_HEADER_NC4
-SUBROUTINE NCWRIT(A,B,C,D,E,F)
-INTEGER :: A,B,C,D,E,F
-PRINT *, 'NCWRIT empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
-END SUBROUTINE NCWRIT
-
-SUBROUTINE NCREAD(A,B,C,D,E)
-INTEGER :: A,B,C,D,E
-PRINT *, 'NCREAD empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
-END SUBROUTINE NCREAD
-
SUBROUTINE CLEANIOCDF(A)
INTEGER :: A
PRINT *, 'CLEANIOCDF empty call. Compile with -DMNH_IOCDF4 flag to enable NetCDF4 I/Os.'
diff --git a/src/LIB/SURCOUCHE/src/modi_fmread.f90 b/src/LIB/SURCOUCHE/src/modi_fmread.f90
deleted file mode 100644
index c1d6968ec..000000000
--- a/src/LIB/SURCOUCHE/src/modi_fmread.f90
+++ /dev/null
@@ -1,224 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-
-MODULE MODI_FMREAD_ll
-!
-INTERFACE FMREAD
- SUBROUTINE FMREADX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL, INTENT(OUT)::PFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADX0_ll
-
- SUBROUTINE FMREADX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
- REAL,DIMENSION(:),TARGET,INTENT(OUT)::PFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
- INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
- END SUBROUTINE FMREADX1_ll
-
- SUBROUTINE FMREADX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP, KIMAX_ll, KJMAX_ll)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:),TARGET, INTENT(OUT)::PFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- INTEGER, OPTIONAL, INTENT(IN) ::KIMAX_ll
- INTEGER, OPTIONAL, INTENT(IN) ::KJMAX_ll
- END SUBROUTINE FMREADX2_ll
-
- SUBROUTINE FMREADX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL, DIMENSION(:,:,:),TARGET,INTENT(OUT)::PFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADX3_ll
-
- SUBROUTINE FMREADX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:),TARGET,INTENT(OUT)::PFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code if
- END SUBROUTINE FMREADX4_ll
-
- SUBROUTINE FMREADX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(OUT)::PFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADX5_ll
-
- SUBROUTINE FMREADX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(OUT)::PFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADX6_ll
-
- SUBROUTINE FMREADN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
- INTEGER, INTENT(OUT)::KFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADN0_ll
-
- SUBROUTINE FMREADN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
- INTEGER,DIMENSION(:),TARGET,INTENT(OUT)::KFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADN1_ll
-
- SUBROUTINE FMREADN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- INTEGER, DIMENSION(:,:),TARGET,INTENT(OUT)::KFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADN2_ll
-
- SUBROUTINE FMREADL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- LOGICAL, INTENT(OUT)::OFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADL0_ll
-
- SUBROUTINE FMREADL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
- LOGICAL, DIMENSION(:), INTENT(OUT)::OFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADL1_ll
-
- SUBROUTINE FMREADC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
- CHARACTER(LEN=*), INTENT(OUT)::HFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADC0_ll
-
- SUBROUTINE FMREADT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_TYPE_DATE
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! Field form
- TYPE (DATE_TIME), INTENT(OUT)::TFIELD ! array containing the data field
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREADT0_ll
-
-END INTERFACE
-
-INTERFACE
- SUBROUTINE FMREAD_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
- & KGRID,KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints
- CHARACTER(LEN=*), INTENT(IN) ::HLBTYPE ! 'LBX','LBXU','LBY' or 'LBYV'
- REAL, DIMENSION(:,:,:),TARGET, INTENT(OUT)::PLB ! array containing the LB field
- INTEGER, INTENT(IN) :: KRIM ! size of the LB area
- INTEGER, INTENT(IN) :: KL3D ! size of the LB array in FM
- INTEGER, INTENT(OUT)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(OUT)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(OUT)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMREAD_LB
-END INTERFACE
-!
-END MODULE MODI_FMREAD_ll
diff --git a/src/LIB/SURCOUCHE/src/modi_fmwrit.f90 b/src/LIB/SURCOUCHE/src/modi_fmwrit.f90
deleted file mode 100644
index 3f2661be2..000000000
--- a/src/LIB/SURCOUCHE/src/modi_fmwrit.f90
+++ /dev/null
@@ -1,301 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-
-MODULE MODI_FMWRIT_ll
-!
-INTERFACE FMWRIT
- SUBROUTINE FMWRITX0_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL, INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITX0_ll
-
- SUBROUTINE FMWRITX1_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITX1_ll
-
- SUBROUTINE FMWRITX2_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITX2_ll
-
- SUBROUTINE FMWRITX3_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITX3_ll
-
- SUBROUTINE FMWRITX4_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITX4_ll
-
- SUBROUTINE FMWRITX5_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITX5_ll
-
- SUBROUTINE FMWRITX6_ll(HFILEM,HRECFM,HFIPRI,HDIR,PFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITX6_ll
-
- SUBROUTINE FMWRITN0_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- INTEGER, INTENT(IN) ::KFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITN0_ll
-
- SUBROUTINE FMWRITN1_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- INTEGER,DIMENSION(:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITN1_ll
-
- SUBROUTINE FMWRITN2_ll(HFILEM,HRECFM,HFIPRI,HDIR,KFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- INTEGER,DIMENSION(:,:),TARGET,INTENT(IN) ::KFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITN2_ll
-
- SUBROUTINE FMWRITL0_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- LOGICAL, INTENT(IN) ::OFIELD ! array containing the data field
- INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITL0_ll
-
- SUBROUTINE FMWRITL1_ll(HFILEM,HRECFM,HFIPRI,HDIR,OFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- LOGICAL,DIMENSION(:),INTENT(IN) ::OFIELD ! array containing the data field
- INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITL1_ll
-
- SUBROUTINE FMWRITC0_ll(HFILEM,HRECFM,HFIPRI,HDIR,HFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- CHARACTER(LEN=*), INTENT(IN) ::HFIELD ! array containing the data field
- INTEGER, INTENT(IN)::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN)::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN)::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITC0_ll
-
- SUBROUTINE FMWRITT0_ll(HFILEM,HRECFM,HFIPRI,HDIR,TFIELD,KGRID,&
- KLENCH,HCOMMENT,KRESP)
- USE MODD_TYPE_DATE
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to read
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HDIR ! field form
- TYPE (DATE_TIME), INTENT(IN) ::TFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITT0_ll
-END INTERFACE
-
-INTERFACE
- SUBROUTINE FMWRIT_LB(HFILEM,HRECFM,HFIPRI,HLBTYPE,PLB,KRIM,KL3D,&
- & KGRID,KLENCH,HCOMMENT,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to be written
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! file for prints in FM
- CHARACTER(LEN=*), INTENT(IN) ::HLBTYPE! 'LBX','LBXU','LBY' or 'LBYV'
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PLB ! array containing the LB field
- INTEGER, INTENT(IN) ::KRIM ! size of the LB area
- INTEGER, INTENT(IN) ::KL3D ! size of the LB array in FM
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- INTEGER, INTENT(IN) ::KLENCH ! length of comment string
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRIT_LB
-END INTERFACE
-
-INTERFACE FMWRITBOX
- SUBROUTINE FMWRITBOXX2_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:),TARGET, INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITBOXX2_ll
-
- SUBROUTINE FMWRITBOXX3_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITBOXX3_ll
-
- SUBROUTINE FMWRITBOXX4_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITBOXX4_ll
-
- SUBROUTINE FMWRITBOXX5_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITBOXX5_ll
-
- SUBROUTINE FMWRITBOXX6_ll(HFILEM,HRECFM,HFIPRI,HBUDGET,PFIELD,KGRID,&
- HCOMMENT,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
- CHARACTER(LEN=*), INTENT(IN) ::HFILEM ! FM-file name
- CHARACTER(LEN=*), INTENT(IN) ::HRECFM ! name of the article to write
- CHARACTER(LEN=*), INTENT(IN) ::HFIPRI ! output file for error messages
- CHARACTER(LEN=*), INTENT(IN) ::HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
- REAL,DIMENSION(:,:,:,:,:,:),TARGET,INTENT(IN) ::PFIELD ! array containing the data field
- INTEGER, INTENT(IN) ::KGRID ! C-grid indicator (u,v,w,T)
- CHARACTER(LEN=*), INTENT(IN) ::HCOMMENT ! comment string
- INTEGER, INTENT(IN) ::KXOBOX !
- INTEGER, INTENT(IN) ::KXEBOX ! Global coordinates of the box
- INTEGER, INTENT(IN) ::KYOBOX !
- INTEGER, INTENT(IN) ::KYEBOX !
- INTEGER, INTENT(OUT)::KRESP ! return-code
- END SUBROUTINE FMWRITBOXX6_ll
-END INTERFACE
-!
-END MODULE MODI_FMWRIT_ll
diff --git a/src/MNH/mnh2lpdm_ech.f90 b/src/MNH/mnh2lpdm_ech.f90
index fb4effaa6..b81644ab4 100644
--- a/src/MNH/mnh2lpdm_ech.f90
+++ b/src/MNH/mnh2lpdm_ech.f90
@@ -35,7 +35,6 @@ USE MODE_FMREAD
!
USE MODI_IO_LL
USE MODI_FM_LL
-USE MODI_FMREAD_LL
USE MODI_INI_CST
!
IMPLICIT NONE
diff --git a/src/MNH/mnh2lpdm_ini.f90 b/src/MNH/mnh2lpdm_ini.f90
index a55957ed6..6f518eb00 100644
--- a/src/MNH/mnh2lpdm_ini.f90
+++ b/src/MNH/mnh2lpdm_ini.f90
@@ -46,7 +46,6 @@ USE MODE_IO_ll
USE MODE_MODELN_HANDLER
USE MODI_XYTOLATLON
!
-USE MODI_FMREAD_LL
USE MODI_INI_CST
USE MODI_READ_HGRID
USE MODI_TEMPORAL_DIST
--
GitLab