diff --git a/src/LIB/SURCOUCHE/src/fmread_ll.f90 b/src/LIB/SURCOUCHE/src/fmread_ll.f90 index 047a96080d2a8b9ebe2e3b9aef59fca2f117fdf8..10c862803697fb325900115f9959c08f3c687512 100644 --- a/src/LIB/SURCOUCHE/src/fmread_ll.f90 +++ b/src/LIB/SURCOUCHE/src/fmread_ll.f90 @@ -24,11 +24,11 @@ USE MODD_IO_ll, ONLY : NVERB_FATAL,NVERB_ERROR,NVERB_WARNING,NVERB_INFO,NVERB_DE USE MODD_MPIF ! USE MODE_FIELD +USE MODE_IO_READ_LFI #if defined(MNH_IOCDF4) USE MODE_IO_READ_NC4 #endif USE MODE_MSG -USE MODE_READWRITE_LFI IMPLICIT NONE diff --git a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 index d679b4915bd5585a6f932948c84f30ee42b87620..f9bcd87aee5c1c60ec848d8ae837afc61567d806 100644 --- a/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 +++ b/src/LIB/SURCOUCHE/src/fmwrit_ll.f90 @@ -1,10 +1,10 @@ !MNH_LIC Copyright 1994-2018 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. !----------------------------------------------------------------- ! Modifications: -! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 +! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 ! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O !----------------------------------------------------------------- @@ -14,161 +14,16 @@ #define MPI_FLOAT MPI_REAL #endif -#ifdef MNH_GA -MODULE MODE_GA -#include "mafdecls.fh" -#include "global.fh" - ! - ! Global Array Variables - ! - INTEGER, PARAMETER :: jpix=1 , jpiy = 2 , jpiz = 3 - ! - INTEGER :: NIMAX_ll,NJMAX_ll, IIU_ll,IJU_ll,IKU_ll - integer :: heap=5*10**6, stack - logical :: gstatus_ga - INTEGER, PARAMETER :: ndim_GA = 3 - INTEGER, DIMENSION(ndim_GA) :: dims_GA , chunk_GA - INTEGER,PARAMETER :: CI=1 ,CJ=-1 ,CK=-1 - INTEGER :: g_a - integer, DIMENSION(ndim_GA) :: lo_col, hi_col , ld_col - integer, DIMENSION(ndim_GA) :: lo_zplan , hi_zplan , ld_zplan - INTEGER :: NIXO_L,NIXE_L,NIYO_L,NIYE_L - INTEGER :: NIXO_G,NIXE_G,NIYO_G,NIYE_G - - LOGICAL,SAVE :: GFIRST_GA = .TRUE. - INTEGER :: IIU_ll_MAX = -1, IJU_ll_MAX = -1, IKU_ll_MAX = -1 - - CONTAINS - - SUBROUTINE MNH_INIT_GA(MY_NI,MY_NJ,MY_NK,HRECFM,HRW_MODE) - -! -! Modification -! J.Escobar 5/02/2015 : use JPHEXT from MODD_PARAMETERS_ll - - USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll - USE MODD_PARAMETERS_ll, ONLY : JPHEXT - USE MODD_IO_ll, ONLY : ISP - USE MODE_GATHER_ll, ONLY : GET_DOMWRITE_ll - USE MODE_SCATTER_ll, ONLY : GET_DOMREAD_ll - - IMPLICIT NONE - - INTEGER, INTENT(IN) :: MY_NI,MY_NJ,MY_NK - CHARACTER(LEN=*), INTENT(IN) :: HRECFM ! name of the article to write - CHARACTER(LEN=*), INTENT(IN) :: HRW_MODE - - IF ( GFIRST_GA ) THEN - GFIRST_GA = .FALSE. - ! - ! Allocate memory for GA library - ! - stack = heap - !gstatus_ga = ma_init(MT_F_DBL, stack/ISNPROC, heap/ISNPROC) - gstatus_ga = ma_init(MT_F_DBL, stack, heap) - if ( .not. gstatus_ga ) STOP " MA_INIT FAILED " - ! - ! Initialize GA library - ! - !call ga_initialize_ltd(100000000) - call ga_initialize() - END IF - - CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll) - IIU_ll = NIMAX_ll + 2*JPHEXT - IJU_ll = NJMAX_ll + 2*JPHEXT - IKU_ll = MY_NK - ! - ! configure Global array dimensions - ! - dims_GA(JPIX) = IIU_ll - dims_GA(JPIY) = IJU_ll - dims_GA(JPIZ) = IKU_ll - chunk_GA(JPIX) = CI - chunk_GA(JPIY) = CJ - chunk_GA(JPIZ) = CK - IF ( CI .EQ. 1 ) chunk_GA(JPIX) = dims_GA(JPIX) ! 1 block in X direction - IF ( CJ .EQ. 1 ) chunk_GA(JPIY) = dims_GA(JPIY) ! 1 block in Y direction - IF ( CK .EQ. 1 ) chunk_GA(JPIZ) = dims_GA(JPIZ) ! 1 block in Z direction - ! - ! (re)create global array g_a ( if to small create it ... ) - ! - IF ( ( IIU_ll .GT. IIU_ll_MAX ) .OR. ( IJU_ll .GT. IJU_ll_MAX ) .OR. ( IKU_ll .GT. IKU_ll_MAX ) ) THEN - ! - ! reallocate the g_a , if need with bigger Z size - ! - IF ( IKU_ll_MAX .NE. -1 ) gstatus_ga = ga_destroy(g_a) - IIU_ll_MAX = IIU_ll - IJU_ll_MAX = IJU_ll - IKU_ll_MAX = IKU_ll - gstatus_ga = nga_create(MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a) - call ga_sync() - END IF - !----------------------------------------------------------------------! - ! ! - ! Define/describe local column data owned by this process to write ! - ! ! - !----------------------------------------------------------------------! - IF ( HRW_MODE .EQ. "WRITE" ) THEN - CALL GET_DOMWRITE_ll(ISP,'local',NIXO_L,NIXE_L,NIYO_L,NIYE_L) - CALL GET_DOMWRITE_ll(ISP,'global',NIXO_G,NIXE_G,NIYO_G,NIYE_G) - ELSE - CALL GET_DOMREAD_ll(ISP,NIXO_L,NIXE_L,NIYO_L,NIYE_L) - CALL GET_DOMREAD_ll(ISP,NIXO_G,NIXE_G,NIYO_G,NIYE_G) - END IF - ! - ! portion of data to write/put | read/get by this proc - ! - lo_col(JPIX) = NIXO_G - hi_col(JPIX) = NIXE_G - - lo_col(JPIY) = NIYO_G - hi_col(JPIY) = NIYE_G - - lo_col(JPIZ) = 1 - hi_col(JPIZ) = IKU_ll - ! - ! declaration size of this local input column array - ! - ld_col(JPIX) = MY_NI - ld_col(JPIY) = MY_NJ - ld_col(JPIZ) = MY_NK - ! - !-----------------------------------------------------! - ! ! - ! Size of local ZSLICE_ll Write buffer on I/O proc ! - ! ! - !-----------------------------------------------------! - ! - ! declared dimension - ! - ld_zplan(JPIX) = IIU_ll - ld_zplan(JPIY) = IJU_ll - ld_zplan(JPIZ) = 1 - ! - ! write data by Z slide by I/O proc - ! - lo_zplan(JPIX:JPIY) = 1 - hi_zplan(JPIX) = IIU_ll - hi_zplan(JPIY) = IJU_ll - !call ga_sync() - ! - END SUBROUTINE MNH_INIT_GA - -END MODULE MODE_GA - -#endif - MODULE MODE_FMWRIT USE MODD_MPIF USE MODD_IO_ll, ONLY: TFILEDATA USE MODE_FIELD + USE MODE_IO_WRITE_LFI #if defined(MNH_IOCDF4) USE MODE_IO_WRITE_NC4 #endif - USE MODE_READWRITE_LFI IMPLICIT NONE diff --git a/src/LIB/SURCOUCHE/src/mode_fm.f90 b/src/LIB/SURCOUCHE/src/mode_fm.f90 index 3f65f8482c5f9e566be21cb4eb579a2d857928ba..4723ab0e7530bcd9a6f42e25bd6cddfc9261adb6 100644 --- a/src/LIB/SURCOUCHE/src/mode_fm.f90 +++ b/src/LIB/SURCOUCHE/src/mode_fm.f90 @@ -156,9 +156,8 @@ IF (PRESENT(KRESP)) KRESP = IRESP END SUBROUTINE IO_FILE_OPEN_ll SUBROUTINE FMOPEN_ll(TPFILE,KRESP,OPARALLELIO,HPROGRAM_ORIG) -USE MODD_IO_ll, ONLY: ISTDOUT,TFILEDATA -USE MODE_IO_ll, ONLY: OPEN_ll,GCONFIO,IOFREEFLU,IONEWFLU -use mode_io_tools, only: io_get_mnhversion,io_set_mnhversion +USE MODD_IO_ll, ONLY: ISTDOUT,TFILEDATA +USE MODE_IO_ll, ONLY: OPEN_ll,GCONFIO,IOFREEFLU,IONEWFLU !JUANZ USE MODD_CONFZ,ONLY : NB_PROCIO_R,NB_PROCIO_W !JUANZ @@ -166,6 +165,8 @@ USE MODD_CONFZ,ONLY : NB_PROCIO_R,NB_PROCIO_W USE MODD_NETCDF, ONLY:IDCDF_KIND use mode_io_file_nc4, only: io_create_file_nc4, io_open_file_nc4 #endif +use mode_io_file_lfi, only: io_create_file_lfi, io_open_file_lfi + TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE ! File structure INTEGER, INTENT(OUT) :: KRESP ! return-code LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO @@ -173,22 +174,11 @@ CHARACTER(LEN=*),INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file comin ! ! Local variables ! -INTEGER :: IFTYPE ! type of FM-file -INTEGER :: IROWF,IRESP -CHARACTER(LEN=7) :: YACTION ! Action upon the file ('READ' or 'WRITE') -CHARACTER(LEN=:),ALLOCATABLE :: YFILEM ! name of the file -CHARACTER(LEN=:),ALLOCATABLE :: YFORSTATUS ! Status for open of a file (for LFI) ('OLD','NEW','UNKNOWN','SCRATCH','REPLACE') -CHARACTER(LEN=8) :: YRESP -LOGICAL :: GSTATS -LOGICAL :: GNAMFI,GFATER,GNEWFI -INTEGER :: IERR -!JUAN -INTEGER(KIND=LFI_INT) :: IRESOU,INUMBR8 -INTEGER(KIND=LFI_INT) :: IMELEV,INPRAR -INTEGER(KIND=LFI_INT) :: ININAR ! Number of articles present in LFI file -LOGICAL :: GNAMFI8,GFATER8,GSTATS8 +INTEGER :: IROWF, IRESP +CHARACTER(LEN=7) :: YACTION ! Action upon the file ('READ' or 'WRITE') +CHARACTER(LEN=8) :: YRESP +INTEGER :: IERR INTEGER :: INB_PROCIO -!JUAN LOGICAL :: GPARALLELIO LOGICAL :: GEXIST_LFI, GEXIST_NC4 @@ -196,16 +186,6 @@ YACTION = TPFILE%CMODE CALL PRINT_MSG(NVERB_DEBUG,'IO','FMOPEN_ll','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(YACTION)) -IF (ALLOCATED(TPFILE%CDIRNAME)) THEN - IF(LEN_TRIM(TPFILE%CDIRNAME)>0) THEN - YFILEM = TRIM(TPFILE%CDIRNAME)//'/'//TRIM(TPFILE%CNAME) - ELSE - YFILEM = TRIM(TPFILE%CNAME) - END IF -ELSE - YFILEM = TRIM(TPFILE%CNAME) -END IF - IF ( PRESENT(OPARALLELIO) ) THEN GPARALLELIO = OPARALLELIO ELSE !par defaut on active les IO paralleles en Z si possible @@ -218,26 +198,9 @@ IF (.NOT. GCONFIO) THEN STOP END IF -ININAR = 0 -INPRAR = TPFILE%NLFINPRAR IROWF = 0 IRESP = 0 -SELECT CASE (TPFILE%NLFIVERB) -CASE(:2) - GSTATS = .FALSE. - IMELEV=0 -CASE(3:6) - GSTATS = .FALSE. - IMELEV=1 -CASE(7:9) - GSTATS = .FALSE. - IMELEV=2 -CASE(10:) - GSTATS = .TRUE. - IMELEV=2 -END SELECT - IROWF=LEN_TRIM(TPFILE%CNAME) IF (IROWF.EQ.0) THEN @@ -252,7 +215,7 @@ ENDIF INB_PROCIO = NB_PROCIO_W END SELECT CALL OPEN_ll(TPFILE,STATUS="UNKNOWN",MODE='IO_ZSPLIT',IOSTAT=IRESP, & - KNB_PROCIO=INB_PROCIO,KMELEV=IMELEV,OPARALLELIO=GPARALLELIO,HPROGRAM_ORIG=HPROGRAM_ORIG) + KNB_PROCIO=INB_PROCIO,OPARALLELIO=GPARALLELIO,HPROGRAM_ORIG=HPROGRAM_ORIG) IF (IRESP /= 0) GOTO 1000 @@ -311,62 +274,21 @@ END IF #if defined(MNH_IOCDF4) IF (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4') THEN - IF (YACTION == 'READ') THEN + SELECT CASE (YACTION) + CASE('READ') call io_open_file_nc4(tpfile) - END IF - - IF (YACTION == 'WRITE') THEN + CASE('WRITE') call io_create_file_nc4(TPFILE, hprogram_orig=HPROGRAM_ORIG) - END IF + END SELECT END IF #endif IF (TPFILE%CFORMAT=='LFI' .OR. TPFILE%CFORMAT=='LFICDF4') THEN - IF (TPFILE%LMASTER) THEN - ! LFI Case - IRESOU = 0 - GNAMFI = .TRUE. - GFATER = .TRUE. - ! - INUMBR8 = TPFILE%NLFIFLU - GNAMFI8 = GNAMFI - GFATER8 = GFATER - GSTATS8 = GSTATS - ! - SELECT CASE (YACTION) - CASE('READ') - YFORSTATUS = 'OLD' - CASE('WRITE') - YFORSTATUS = 'REPLACE' - END SELECT - ! - CALL LFIOUV(IRESOU, & - INUMBR8, & - GNAMFI8, & - TRIM(YFILEM)//'.lfi', & - YFORSTATUS, & - GFATER8, & - GSTATS8, & - IMELEV, & - INPRAR, & - ININAR) - TPFILE%NLFININAR = ININAR - IF (IRESOU /= 0 ) THEN - IRESP = IRESOU - ENDIF - ! - !* 6. TEST IF FILE IS NEWLY DEFINED - ! - GNEWFI=(ININAR==0).OR.(IMELEV<2) - IF (.NOT.GNEWFI) THEN - WRITE (ISTDOUT,*) ' file ',TRIM(YFILEM)//'.lfi',' previously created with LFI' - ENDIF - END IF SELECT CASE (YACTION) CASE('READ') - call io_get_mnhversion(tpfile) + call io_open_file_lfi(tpfile,iresp) CASE('WRITE') - call io_set_mnhversion(tpfile) + call io_create_file_lfi(tpfile,iresp) END SELECT END IF @@ -379,13 +301,13 @@ IF (IRESP /= 0) GOTO 1000 IF (IRESP.NE.0) THEN WRITE(YRESP,"( I0 )") IRESP - CALL PRINT_MSG(NVERB_ERROR,'IO','FMOPEN_ll',TRIM(YFILEM)//': exit with IRESP='//TRIM(YRESP)) + CALL PRINT_MSG(NVERB_ERROR,'IO','FMOPEN_ll',TRIM(TPFILE%CNAME)//': exit with IRESP='//TRIM(YRESP)) END IF KRESP=IRESP END SUBROUTINE FMOPEN_ll - + SUBROUTINE IO_FILE_CLOSE_ll(TPFILE,KRESP,OPARALLELIO,HPROGRAM_ORIG) ! USE MODD_CONF, ONLY: CPROGRAM @@ -491,13 +413,13 @@ SELECT CASE(TPFILE%CTYPE) TZFILE_DES%NCLOSE = TZFILE_DES%NCLOSE + 1 ! IF (TZFILE_DES%NOPEN_CURRENT==0) THEN - CALL CLOSE_ll(TZFILE_DES,IOSTAT=IRESP,STATUS='KEEP') + CALL CLOSE_ll(TZFILE_DES,IOSTAT=IRESP) TZFILE_DES%LOPENED = .FALSE. TZFILE_DES%NLU = -1 END IF ENDIF ! - CALL FMCLOS_ll(TPFILE,'KEEP',KRESP=IRESP,OPARALLELIO=OPARALLELIO,HPROGRAM_ORIG=HPROGRAM_ORIG) + CALL FMCLOS_ll(TPFILE,KRESP=IRESP,OPARALLELIO=OPARALLELIO,HPROGRAM_ORIG=HPROGRAM_ORIG) ! TPFILE%NLFIFLU = -1 TPFILE%NNCID = -1 @@ -525,7 +447,7 @@ IF (PRESENT(KRESP)) KRESP=IRESP ! END SUBROUTINE IO_FILE_CLOSE_ll -SUBROUTINE FMCLOS_ll(TPFILE,HSTATU,KRESP,OPARALLELIO,HPROGRAM_ORIG) +SUBROUTINE FMCLOS_ll(TPFILE,KRESP,OPARALLELIO,HPROGRAM_ORIG) ! !! MODIFICATIONS !! ------------- @@ -538,28 +460,25 @@ USE MODE_IO_ll, ONLY : CLOSE_ll,UPCASE #if !defined(MNH_SGI) USE MODI_SYSTEM_MNH #endif + use mode_io_file_lfi, only: io_close_file_lfi #if defined(MNH_IOCDF4) use mode_io_file_nc4, only: io_close_file_nc4 use mode_io_write_nc4, only: io_write_coordvar_nc4 #endif TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure -CHARACTER(LEN=*), INTENT(IN) :: HSTATU ! status for the closed file INTEGER, INTENT(OUT), OPTIONAL :: KRESP ! return-code if problems araised LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program -INTEGER ::IRESP,IROWF -CHARACTER(LEN=28) :: YFILEM ! name of the file -CHARACTER(LEN=7) ::YSTATU -LOGICAL ::GSTATU +INTEGER :: IRESP,IROWF +CHARACTER(LEN=28) :: YFILEM ! name of the file CHARACTER(LEN=8) :: YRESP -CHARACTER(LEN=10) ::YCPIO -CHARACTER(LEN=14) ::YTRANS -CHARACTER(LEN=100) ::YCOMMAND +CHARACTER(LEN=10) :: YCPIO +CHARACTER(LEN=14) :: YTRANS +CHARACTER(LEN=100) :: YCOMMAND INTEGER :: IERR, IFITYP INTEGER, SAVE :: ICPT=0 -INTEGER(KIND=LFI_INT) :: IRESP8 -LOGICAL :: GPARALLELIO +LOGICAL :: GPARALLELIO YFILEM = TPFILE%CNAME @@ -581,18 +500,6 @@ IF (IROWF.EQ.0) THEN GOTO 1000 ENDIF -IF (LEN(HSTATU).LE.0) THEN - IRESP=-41 - GOTO 1000 -ELSE - YSTATU = HSTATU - YSTATU = UPCASE(TRIM(ADJUSTL(YSTATU))) - GSTATU=YSTATU=='KEEP'.OR.YSTATU=='DELETE' - IF (.NOT. GSTATU) THEN - YSTATU='DEFAULT' - ENDIF -ENDIF - #if defined(MNH_IOCDF4) !Write coordinates variables in NetCDF file IF (TPFILE%CMODE == 'WRITE' .AND. (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4')) THEN @@ -601,15 +508,9 @@ END IF #endif IF (TPFILE%LMASTER) THEN - IF (TPFILE%NLFIFLU > 0) THEN - CALL LFIFER(IRESP8,TPFILE%NLFIFLU,YSTATU) - IRESP = IRESP8 - END IF + if (tpfile%cformat == 'LFI' .or. tpfile%cformat == 'LFICDF4') call io_close_file_lfi(tpfile,iresp) #if defined(MNH_IOCDF4) - IF (TPFILE%NNCID/=-1) THEN - ! Close Netcdf File - call io_close_file_nc4(tpfile,iresp) - END IF + if (tpfile%cformat == 'NETCDF4' .or. tpfile%cformat == 'LFICDF4') call io_close_file_nc4(tpfile,iresp) #endif IF (IRESP == 0 .AND. CPROGRAM/='LFICDF') THEN !! Write in pipe @@ -657,7 +558,7 @@ END IF 500 CALL MPI_BCAST(IRESP,1,MPI_INTEGER,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR) IF (IRESP /= 0) GOTO 1000 -CALL CLOSE_ll(TPFILE,IOSTAT=IRESP,STATUS=YSTATU,OPARALLELIO=GPARALLELIO) +CALL CLOSE_ll(TPFILE,IOSTAT=IRESP,OPARALLELIO=GPARALLELIO) 1000 CONTINUE diff --git a/src/LIB/SURCOUCHE/src/mode_ga.f90 b/src/LIB/SURCOUCHE/src/mode_ga.f90 new file mode 100644 index 0000000000000000000000000000000000000000..7457a7f3e20a8cdc4efc505078488034d0e698b9 --- /dev/null +++ b/src/LIB/SURCOUCHE/src/mode_ga.f90 @@ -0,0 +1,154 @@ +!MNH_LIC Copyright 1994-2018 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. +!----------------------------------------------------------------- +! Author: J.Escobar +! +! Modifications: +! P.Wautelet: 14/12/2018: split from fmwrit_ll.f90 +!----------------------------------------------------------------- +#ifdef MNH_GA +MODULE MODE_GA +#include "mafdecls.fh" +#include "global.fh" + ! + ! Global Array Variables + ! + INTEGER, PARAMETER :: jpix=1 , jpiy = 2 , jpiz = 3 + ! + INTEGER :: NIMAX_ll,NJMAX_ll, IIU_ll,IJU_ll,IKU_ll + integer :: heap=5*10**6, stack + logical :: gstatus_ga + INTEGER, PARAMETER :: ndim_GA = 3 + INTEGER, DIMENSION(ndim_GA) :: dims_GA , chunk_GA + INTEGER,PARAMETER :: CI=1 ,CJ=-1 ,CK=-1 + INTEGER :: g_a + integer, DIMENSION(ndim_GA) :: lo_col, hi_col , ld_col + integer, DIMENSION(ndim_GA) :: lo_zplan , hi_zplan , ld_zplan + INTEGER :: NIXO_L,NIXE_L,NIYO_L,NIYE_L + INTEGER :: NIXO_G,NIXE_G,NIYO_G,NIYE_G + + LOGICAL,SAVE :: GFIRST_GA = .TRUE. + INTEGER :: IIU_ll_MAX = -1, IJU_ll_MAX = -1, IKU_ll_MAX = -1 + + CONTAINS + + SUBROUTINE MNH_INIT_GA(MY_NI,MY_NJ,MY_NK,HRECFM,HRW_MODE) + +! +! Modification +! J.Escobar 5/02/2015 : use JPHEXT from MODD_PARAMETERS_ll + + USE MODE_TOOLS_ll, ONLY : GET_GLOBALDIMS_ll + USE MODD_PARAMETERS_ll, ONLY : JPHEXT + USE MODD_IO_ll, ONLY : ISP + USE MODE_GATHER_ll, ONLY : GET_DOMWRITE_ll + USE MODE_SCATTER_ll, ONLY : GET_DOMREAD_ll + + IMPLICIT NONE + + INTEGER, INTENT(IN) :: MY_NI,MY_NJ,MY_NK + CHARACTER(LEN=*), INTENT(IN) :: HRECFM ! name of the article to write + CHARACTER(LEN=*), INTENT(IN) :: HRW_MODE + + IF ( GFIRST_GA ) THEN + GFIRST_GA = .FALSE. + ! + ! Allocate memory for GA library + ! + stack = heap + !gstatus_ga = ma_init(MT_F_DBL, stack/ISNPROC, heap/ISNPROC) + gstatus_ga = ma_init(MT_F_DBL, stack, heap) + if ( .not. gstatus_ga ) STOP " MA_INIT FAILED " + ! + ! Initialize GA library + ! + !call ga_initialize_ltd(100000000) + call ga_initialize() + END IF + + CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll) + IIU_ll = NIMAX_ll + 2*JPHEXT + IJU_ll = NJMAX_ll + 2*JPHEXT + IKU_ll = MY_NK + ! + ! configure Global array dimensions + ! + dims_GA(JPIX) = IIU_ll + dims_GA(JPIY) = IJU_ll + dims_GA(JPIZ) = IKU_ll + chunk_GA(JPIX) = CI + chunk_GA(JPIY) = CJ + chunk_GA(JPIZ) = CK + IF ( CI .EQ. 1 ) chunk_GA(JPIX) = dims_GA(JPIX) ! 1 block in X direction + IF ( CJ .EQ. 1 ) chunk_GA(JPIY) = dims_GA(JPIY) ! 1 block in Y direction + IF ( CK .EQ. 1 ) chunk_GA(JPIZ) = dims_GA(JPIZ) ! 1 block in Z direction + ! + ! (re)create global array g_a ( if to small create it ... ) + ! + IF ( ( IIU_ll .GT. IIU_ll_MAX ) .OR. ( IJU_ll .GT. IJU_ll_MAX ) .OR. ( IKU_ll .GT. IKU_ll_MAX ) ) THEN + ! + ! reallocate the g_a , if need with bigger Z size + ! + IF ( IKU_ll_MAX .NE. -1 ) gstatus_ga = ga_destroy(g_a) + IIU_ll_MAX = IIU_ll + IJU_ll_MAX = IJU_ll + IKU_ll_MAX = IKU_ll + gstatus_ga = nga_create(MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a) + call ga_sync() + END IF + !----------------------------------------------------------------------! + ! ! + ! Define/describe local column data owned by this process to write ! + ! ! + !----------------------------------------------------------------------! + IF ( HRW_MODE .EQ. "WRITE" ) THEN + CALL GET_DOMWRITE_ll(ISP,'local',NIXO_L,NIXE_L,NIYO_L,NIYE_L) + CALL GET_DOMWRITE_ll(ISP,'global',NIXO_G,NIXE_G,NIYO_G,NIYE_G) + ELSE + CALL GET_DOMREAD_ll(ISP,NIXO_L,NIXE_L,NIYO_L,NIYE_L) + CALL GET_DOMREAD_ll(ISP,NIXO_G,NIXE_G,NIYO_G,NIYE_G) + END IF + ! + ! portion of data to write/put | read/get by this proc + ! + lo_col(JPIX) = NIXO_G + hi_col(JPIX) = NIXE_G + + lo_col(JPIY) = NIYO_G + hi_col(JPIY) = NIYE_G + + lo_col(JPIZ) = 1 + hi_col(JPIZ) = IKU_ll + ! + ! declaration size of this local input column array + ! + ld_col(JPIX) = MY_NI + ld_col(JPIY) = MY_NJ + ld_col(JPIZ) = MY_NK + ! + !-----------------------------------------------------! + ! ! + ! Size of local ZSLICE_ll Write buffer on I/O proc ! + ! ! + !-----------------------------------------------------! + ! + ! declared dimension + ! + ld_zplan(JPIX) = IIU_ll + ld_zplan(JPIY) = IJU_ll + ld_zplan(JPIZ) = 1 + ! + ! write data by Z slide by I/O proc + ! + lo_zplan(JPIX:JPIY) = 1 + hi_zplan(JPIX) = IIU_ll + hi_zplan(JPIY) = IJU_ll + !call ga_sync() + ! + END SUBROUTINE MNH_INIT_GA + +END MODULE MODE_GA + +#endif diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90 index 94a22635319ce2e7fcd33456b579cc8d93451ac5..0693a170a6221f84e96b40dd024343037304f935 100644 --- a/src/LIB/SURCOUCHE/src/mode_io.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io.f90 @@ -199,18 +199,17 @@ CONTAINS DELIM, & PAD, & KNB_PROCIO,& - KMELEV,& OPARALLELIO, & HPROGRAM_ORIG) + USE MODD_IO_ll #if defined(MNH_IOCDF4) - USE MODD_NETCDF, ONLY:IDCDF_KIND - use mode_io_file_nc4, only: io_create_file_nc4, io_open_file_nc4 + USE MODD_NETCDF, ONLY:IDCDF_KIND + use mode_io_file_nc4, only: io_create_file_nc4, io_open_file_nc4 #endif - USE MODD_IO_ll - - USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST, IO_FILE_FIND_BYNAME - use mode_io_tools, only: io_rank, io_get_mnhversion,io_set_mnhversion + use mode_io_file_lfi, only: io_create_file_lfi, io_open_file_lfi + USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST, IO_FILE_FIND_BYNAME + use mode_io_tools, only: io_rank TYPE(TFILEDATA), INTENT(INOUT) :: TPFILE CHARACTER(len=*),INTENT(IN), OPTIONAL :: MODE @@ -225,19 +224,13 @@ CONTAINS CHARACTER(len=*),INTENT(IN), OPTIONAL :: PAD INTEGER, INTENT(IN), OPTIONAL :: COMM INTEGER, INTENT(IN), OPTIONAL :: KNB_PROCIO - INTEGER(KIND=LFI_INT), INTENT(IN), OPTIONAL :: KMELEV LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO CHARACTER(LEN=*),INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program ! ! local var ! - !JUANZ CHARACTER(len=5) :: CFILE INTEGER :: IFILE, IRANK_PROCIO - INTEGER(KIND=LFI_INT) :: IRESOU,IMELEV,INPRAR - INTEGER(KIND=LFI_INT) :: ININAR8 - LOGICAL(KIND=LFI_INT) :: GNAMFI8,GFATER8,GSTATS8 - !JUANZ #if defined(MNH_SX5) || defined(MNH_SP4) || defined(NAGf95) || defined(MNH_LINUX) CHARACTER(len=20) :: YSTATUS @@ -254,13 +247,8 @@ CONTAINS CHARACTER(len=20) :: YACTION CHARACTER(len=20) :: YMODE CHARACTER(LEN=256) :: YIOERRMSG - INTEGER :: IOS,IERR,IRESP + INTEGER :: IOS,IRESP INTEGER :: ICOMM - INTEGER :: ICMPRES - ! didier - LOGICAL :: GEXISTS,GOPENED - INTEGER :: IUNIT - ! didier LOGICAL :: GPARALLELIO TYPE(TFILEDATA),POINTER :: TZSPLITFILE CHARACTER(LEN=:),ALLOCATABLE :: YPREFILENAME !To store the directory + filename @@ -703,50 +691,11 @@ CONTAINS END IF #endif IF (TZSPLITFILE%CFORMAT=='LFI' .OR. TZSPLITFILE%CFORMAT=='LFICDF4') THEN - IF ( TZSPLITFILE%LMASTER ) THEN - ! LFI case - ! Open LFI File for reading - !this proc must write on this file open it ... - TZSPLITFILE%NLFIFLU = IONEWFLU() - !! LFI-File case - IRESOU = 0 - GNAMFI8 = .TRUE. - GFATER8 = .TRUE. - GSTATS8 = .FALSE. - IF (PRESENT(KMELEV)) THEN - IMELEV = KMELEV - ELSE - IMELEV = 0 - ENDIF - INPRAR = 49 - ! - SELECT CASE (YACTION) - CASE('READ') - YFORSTATUS = 'OLD' - CASE('WRITE') - YFORSTATUS = 'REPLACE' - END SELECT - ! - ! JUAN open lfi file temporary modif - ! - CALL LFIOUV(IRESOU, & - TZSPLITFILE%NLFIFLU, & - GNAMFI8, & - TRIM(YPREFILENAME)//'.lfi', & - YFORSTATUS, & - GFATER8, & - GSTATS8, & - IMELEV, & - INPRAR, & - ININAR8) - TZSPLITFILE%NLFININAR = ININAR8 - END IF - ! SELECT CASE (YACTION) CASE('READ') - call io_get_mnhversion(tpfile) + call io_open_file_lfi(tzsplitfile,iresp) CASE('WRITE') - call io_set_mnhversion(tpfile) + call io_create_file_lfi(tzsplitfile,iresp) END SELECT ENDIF ! @@ -776,25 +725,23 @@ CONTAINS END SUBROUTINE OPEN_ll - SUBROUTINE CLOSE_ll(TPFILE,IOSTAT,STATUS,OPARALLELIO,HPROGRAM_ORIG) + SUBROUTINE CLOSE_ll(TPFILE,IOSTAT,OPARALLELIO,HPROGRAM_ORIG) USE MODD_IO_ll + USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_FIND_BYNAME + use mode_io_file_lfi, only: io_close_file_lfi #if defined(MNH_IOCDF4) use mode_io_file_nc4, only: io_close_file_nc4 use mode_io_write_nc4, only: io_write_coordvar_nc4 #endif TYPE(TFILEDATA), INTENT(IN) :: TPFILE INTEGER, INTENT(OUT), OPTIONAL :: IOSTAT - CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: STATUS LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program INTEGER :: IERR, IGLOBALERR, IGLOBALERR2, IRESP, IRESP2 - CHARACTER(LEN=100) :: STATUSL INTEGER :: IFILE - INTEGER(KIND=LFI_INT) :: IRESP8 - CHARACTER(LEN=7) :: YSTATU LOGICAL :: GPARALLELIO TYPE(TFILEDATA),POINTER :: TZFILE @@ -811,15 +758,10 @@ CONTAINS IRESP2 = 0 IGLOBALERR = 0 IGLOBALERR2 = 0 - IF (PRESENT(STATUS)) THEN - STATUSL = STATUS - ELSE - STATUSL = "KEEP" - ENDIF IF (TPFILE%LMASTER) THEN IF (TPFILE%NLU>0 .AND. TPFILE%NLU/=JPFNULL) THEN - CLOSE(UNIT=TPFILE%NLU, IOSTAT=IRESP,STATUS=STATUSL) + CLOSE(UNIT=TPFILE%NLU, IOSTAT=IRESP,STATUS='KEEP') CALL IOFREEFLU(TPFILE%NLU) END IF END IF @@ -834,17 +776,13 @@ CONTAINS END IF #endif IF (TPFILE%LMASTER) THEN - IF (TZFILE%NLFIFLU > 0) THEN !if LFI - CALL LFIFER(IRESP8,TZFILE%NLFIFLU,YSTATU) - CALL IOFREEFLU(INT(TPFILE%NLFIFLU)) - IRESP2 = IRESP8 - END IF + if (tzfile%cformat == 'LFI' .or. tzfile%cformat == 'LFICDF4') call io_close_file_lfi(tzfile,iresp2) #if defined(MNH_IOCDF4) - IF (TZFILE%NNCID/=-1) THEN - ! Close Netcdf File - call io_close_file_nc4(tzfile) - END IF + if (tzfile%cformat == 'NETCDF4' .or. tzfile%cformat == 'LFICDF4') call io_close_file_nc4(tzfile,iresp2) #endif + IF (TZFILE%NLFIFLU > 0) THEN !if LFI + CALL IOFREEFLU(INT(TZFILE%NLFIFLU)) + END IF END IF END DO ! diff --git a/src/LIB/SURCOUCHE/src/mode_io_file_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_file_lfi.f90 new file mode 100644 index 0000000000000000000000000000000000000000..e477754859822771d91d2c6df108474ae1aa4b23 --- /dev/null +++ b/src/LIB/SURCOUCHE/src/mode_io_file_lfi.f90 @@ -0,0 +1,149 @@ +!MNH_LIC Copyright 2018-2018 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. +!----------------------------------------------------------------- +! Author: P. Wautelet 14/12/2018 +! +! Remarks: some of the code comes from mode_fm.f90 and mode_io.f90 +! (was duplicated in the 2 files) +! +! Modifications: +! +!----------------------------------------------------------------- +module mode_io_file_lfi + +use modd_io_ll, only: tfiledata +use modd_netcdf, only: idcdf_kind + +use mode_msg + +implicit none + +private + +public :: io_create_file_lfi, io_close_file_lfi, io_open_file_lfi + +contains + +subroutine io_create_file_lfi(tpfile, kstatus) + use mode_io_tools, only: io_construct_filename + use mode_io_tools_lfi, only: io_prepare_verbosity_lfi + use mode_io_tools_mnhversion, only: io_set_mnhversion + + type(tfiledata), intent(inout) :: tpfile + integer, intent(inout) :: kstatus + + character(len=:), allocatable :: yfilem ! name of the file + character(len=:), allocatable :: yforstatus ! Status for open of a file (for LFI) ('OLD','NEW','UNKNOWN','SCRATCH','REPLACE') + integer(kind=LFI_INT) :: iresou, inumbr + integer(kind=LFI_INT) :: imelev, inprar + integer(kind=LFI_INT) :: ininar ! Number of articles present in LFI file + logical :: gnewfi + logical :: gnamfi, gfater, gstats + + call print_msg(NVERB_DEBUG,'IO','io_create_file_lfi','called for '//trim(tpfile%cname)) + + kstatus = 0 + + if (tpfile%lmaster) then + call io_construct_filename(tpfile, yfilem) + + iresou = 0 + inumbr = tpfile%nlfiflu + gnamfi = .true. + yforstatus = 'REPLACE' + gfater = .true. + + call io_prepare_verbosity_lfi(tpfile, imelev, gstats) + + inprar = tpfile%nlfinprar + + call lfiouv(iresou, inumbr, gnamfi, trim(yfilem)//'.lfi', yforstatus, gfater, gstats, imelev, inprar, ininar) + + tpfile%nlfininar = ininar + + if (iresou/=0) kstatus = int(iresou, kind=kind(kstatus)) + + !test if file is newly defined + gnewfi = (ininar==0) .or. (imelev<2) + if (.not.gnewfi) then + call print_msg(NVERB_INFO,'IO','file '//trim(yfilem)//'.lfi',' previously created with LFI') + endif + end if + call io_set_mnhversion(tpfile) +end subroutine io_create_file_lfi + + +subroutine io_close_file_lfi(tpfile, kstatus) +! use mode_io_tools_nc4, only: cleaniocdf + + type(tfiledata), intent(in) :: tpfile + integer, optional, intent(out) :: kstatus + + character(len=*), parameter :: YSTATUS = 'KEEP' + + integer(kind=LFI_INT) :: istatus + + call print_msg(NVERB_DEBUG,'IO','io_close_file_lfi','called for '//trim(tpfile%cname)) + + istatus = 0 + + if (tpfile%lmaster) then + if ( tpfile%nlfiflu > 0 ) then + call lfifer(istatus, tpfile%nlfiflu, YSTATUS) + else + istatus = -1 + call print_msg(NVERB_WARNING, 'IO', 'io_close_file_lfi', 'file '//trim(tpfile%cname)//'.lfi is not opened') + end if + end if + + if (present(kstatus)) kstatus = int(istatus,kind=kind(kstatus)) +end subroutine io_close_file_lfi + + +subroutine io_open_file_lfi(tpfile, kstatus) + use mode_io_tools, only: io_construct_filename + use mode_io_tools_lfi, only: io_prepare_verbosity_lfi + use mode_io_tools_mnhversion, only: io_get_mnhversion + + type(tfiledata), intent(inout) :: tpfile + integer, intent(inout) :: kstatus + + character(len=:),allocatable :: yfilem ! name of the file + character(len=:),allocatable :: yforstatus ! Status for open of a file (for LFI) ('OLD','NEW','UNKNOWN','SCRATCH','REPLACE') + integer :: istatus + integer(kind=LFI_INT) :: iresou, inumbr + integer(kind=LFI_INT) :: imelev, inprar + integer(kind=LFI_INT) :: ininar ! Number of articles present in LFI file + logical :: gnewfi + logical :: gnamfi, gfater, gstats + + call print_msg(NVERB_DEBUG,'IO','io_open_file_lfi','called for '//trim(tpfile%cname)) + + kstatus = 0 + + if (tpfile%lmaster) then + call io_construct_filename(tpfile, yfilem) + + iresou = 0 + inumbr = tpfile%nlfiflu + gnamfi = .true. + yforstatus = 'OLD' + gfater = .true. + + call io_prepare_verbosity_lfi(tpfile, imelev, gstats) + + inprar = tpfile%nlfinprar + + call lfiouv(iresou, inumbr, gnamfi, trim(yfilem)//'.lfi', yforstatus, gfater, gstats, imelev, inprar, ininar) + + tpfile%nlfininar = ininar + + if (iresou/=0) kstatus = int(iresou, kind=kind(kstatus)) + end if + call io_get_mnhversion(tpfile) +end subroutine io_open_file_lfi + + +end module mode_io_file_lfi diff --git a/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90 index f12b09bbfbc2be5ac8a9de090d4d2b89f0f5b608..4738a2fc0b4e3537e7b498bba02b2a382d630615 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90 @@ -15,7 +15,7 @@ module mode_io_file_nc4 use modd_io_ll, only: tfiledata -use modd_netcdf, only: idcdf_kind +use modd_netcdf, only: IDCDF_KIND use mode_io_tools_nc4, only: handle_err, io_set_knowndims_nc4, newiocdf use mode_msg @@ -33,27 +33,21 @@ public :: io_create_file_nc4, io_close_file_nc4, io_open_file_nc4 contains subroutine io_create_file_nc4(tpfile,hprogram_orig) - use mode_io_tools, only: io_set_mnhversion + use mode_io_tools, only: io_construct_filename + use mode_io_tools_mnhversion, only: io_set_mnhversion type(tfiledata), intent(inout) :: tpfile character(len=*),optional, intent(in) :: hprogram_orig !to emulate a file coming from this program character(len=:),allocatable :: yfilem ! name of the file - integer(kind=idcdf_kind) :: istatus + integer(kind=IDCDF_KIND) :: istatus + + call print_msg(NVERB_DEBUG,'IO','io_create_file_nc4','called for '//trim(tpfile%cname)) if (tpfile%lmaster) then - if (allocated(tpfile%cdirname)) then - if(len_trim(tpfile%cdirname)>0) then - yfilem = trim(tpfile%cdirname)//'/'//trim(tpfile%cname) - else - yfilem = trim(tpfile%cname) - end if - else - yfilem = trim(tpfile%cname) - end if + call io_construct_filename(tpfile, yfilem) tpfile%tncdims => newiocdf() - call print_msg(NVERB_DEBUG, 'IO', 'io_create_file_nc4', 'NF90_CREATE for '//trim(yfilem)//'.nc') istatus = NF90_CREATE(adjustl(trim(yfilem))//".nc", ior(NF90_CLOBBER,NF90_NETCDF4), tpfile%nncid) if (istatus /= NF90_NOERR) then call print_msg(NVERB_FATAL,'IO','io_create_file_nc4','NF90_CREATE for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus)) @@ -69,21 +63,25 @@ subroutine io_close_file_nc4(tpfile,kstatus) use mode_io_tools_nc4, only: cleaniocdf type(tfiledata), intent(in) :: tpfile - integer(kind=idcdf_kind), optional, intent(out) :: kstatus + integer(kind=IDCDF_KIND), optional, intent(out) :: kstatus - integer(kind=idcdf_kind) :: istatus + integer(kind=IDCDF_KIND) :: istatus call print_msg(NVERB_DEBUG,'IO','io_close_file_nc4','called for '//trim(tpfile%cname)) istatus = 0 - if (tpfile%lmaster) then - if (trim(tpfile%cmode) == 'WRITE') call io_set_cleanly_closed_nc4(tpfile) - istatus = NF90_CLOSE(tpfile%nncid) - if (istatus /= NF90_NOERR) then - call print_msg(NVERB_WARNING, 'IO', 'io_close_file_nc4', 'NF90_CLOSE error: '//trim(NF90_STRERROR(istatus))) + if (tpfile%lmaster ) then + if (tpfile%nncid == -1) then + call print_msg(NVERB_WARNING, 'IO', 'io_close_file_nc4', 'file '//trim(tpfile%cname)//'.nc is not opened') + else + if (trim(tpfile%cmode) == 'WRITE') call io_set_cleanly_closed_nc4(tpfile) + istatus = NF90_CLOSE(tpfile%nncid) + if (istatus /= NF90_NOERR) then + call print_msg(NVERB_WARNING, 'IO', 'io_close_file_nc4', 'NF90_CLOSE error: '//trim(NF90_STRERROR(istatus))) + end if + if (associated(tpfile%tncdims)) call cleaniocdf(tpfile%tncdims) end if - if (associated(tpfile%tncdims)) call cleaniocdf(tpfile%tncdims) end if if (present(kstatus)) kstatus = istatus @@ -91,26 +89,20 @@ end subroutine io_close_file_nc4 subroutine io_open_file_nc4(tpfile) - use mode_io_tools, only: io_get_mnhversion + use mode_io_tools, only: io_construct_filename + use mode_io_tools_mnhversion, only: io_get_mnhversion type(tfiledata), intent(inout) :: tpfile character(len=:),allocatable :: yfilem ! name of the file - integer(kind=idcdf_kind) :: istatus + integer(kind=IDCDF_KIND) :: istatus + + call print_msg(NVERB_DEBUG,'IO','io_open_file_nc4','called for '//trim(tpfile%cname)) if (tpfile%lmaster) then - if (allocated(tpfile%cdirname)) then - if(len_trim(tpfile%cdirname)>0) then - yfilem = trim(tpfile%cdirname)//'/'//trim(tpfile%cname) - else - yfilem = trim(tpfile%cname) - end if - else - yfilem = trim(tpfile%cname) - end if + call io_construct_filename(tpfile, yfilem) tpfile%tncdims => newiocdf() - call print_msg(NVERB_DEBUG,'IO','io_open_file_nc4','NF90_OPEN for '//trim(yfilem)//'.nc') istatus = NF90_OPEN(adjustl(trim(yfilem))//".nc", NF90_NOWRITE, tpfile%nncid) if (istatus /= NF90_NOERR) then call print_msg(NVERB_FATAL, 'IO', 'io_open_file_nc4', 'NF90_OPEN for '//trim(yfilem)//'.nc: '//NF90_STRERROR(istatus)) diff --git a/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 new file mode 100644 index 0000000000000000000000000000000000000000..91e4e003121e20e44b39b5fa3ef2a067a4ccea8c --- /dev/null +++ b/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 @@ -0,0 +1,774 @@ +!MNH_LIC Copyright 1994-2018 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. +!----------------------------------------------------------------- +module mode_io_read_lfi +! Modifications: +! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O +! Philippe Wautelet: 21/06/2018: read and write correctly if MNH_REAL=4 +! Philippe Wautelet: 14/12/2018: split fmreadwrit.f90 +! +USE MODD_IO_ll +USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH +! +USE MODE_FIELD, ONLY : TFIELDDATA +USE MODE_MSG +! +IMPLICIT NONE +! +PRIVATE +! +INTEGER, PARAMETER :: JPXKRK = NLFIMAXCOMMENTLENGTH +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, & + IO_READ_FIELD_LFI_X4, IO_READ_FIELD_LFI_X5, & + IO_READ_FIELD_LFI_X6, & + IO_READ_FIELD_LFI_N0, IO_READ_FIELD_LFI_N1, & + IO_READ_FIELD_LFI_N2, & + IO_READ_FIELD_LFI_L0, IO_READ_FIELD_LFI_L1, & + IO_READ_FIELD_LFI_C0, & + IO_READ_FIELD_LFI_T0 +END INTERFACE IO_READ_FIELD_LFI +! +PUBLIC IO_READ_FIELD_LFI +! +CONTAINS +! +SUBROUTINE IO_READ_FIELD_LFI_X0(TPFILE,TPFIELD,PFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +REAL, INTENT(OUT) :: PFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +REAL,DIMENSION(1) :: ZFIELD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = 1 +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) THEN + !TRANSFER_I8_R works with 1D arrays + ZFIELD = TRANSFER_I8_R( (/ IWORK(IWORK(2)+3) /) ) + PFIELD = ZFIELD(1) +END IF +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_X0 +! +! +SUBROUTINE IO_READ_FIELD_LFI_X1(TPFILE,TPFIELD,PFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +REAL,DIMENSION(:),INTENT(OUT) :: PFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = SIZE(PFIELD) +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) PFIELD = TRANSFER_I8_R(IWORK(IWORK(2)+3:)) +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_X1 +! +! +SUBROUTINE IO_READ_FIELD_LFI_X2(TPFILE,TPFIELD,PFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +REAL,DIMENSION(:,:),INTENT(OUT) :: PFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = SIZE(PFIELD) +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) ) +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_X2 +! +! +SUBROUTINE IO_READ_FIELD_LFI_X3(TPFILE,TPFIELD,PFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +REAL,DIMENSION(:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = SIZE(PFIELD) +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) ) +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_X3 +! +! +SUBROUTINE IO_READ_FIELD_LFI_X4(TPFILE,TPFIELD,PFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +REAL,DIMENSION(:,:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = SIZE(PFIELD) +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) ) +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_X4 +! +! +SUBROUTINE IO_READ_FIELD_LFI_X5(TPFILE,TPFIELD,PFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +REAL,DIMENSION(:,:,:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = SIZE(PFIELD) +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) ) +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_X5 +! +! +SUBROUTINE IO_READ_FIELD_LFI_X6(TPFILE,TPFIELD,PFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +REAL,DIMENSION(:,:,:,:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = SIZE(PFIELD) +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) ) +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_X6 +! +! +SUBROUTINE IO_READ_FIELD_LFI_N0(TPFILE,TPFIELD,KFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD +INTEGER, INTENT(OUT) :: KFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = 1 +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) KFIELD = IWORK(IWORK(2)+3) +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_N0 +! +! +SUBROUTINE IO_READ_FIELD_LFI_N1(TPFILE,TPFIELD,KFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +INTEGER,DIMENSION(:),INTENT(OUT) :: KFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = SIZE(KFIELD) +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) KFIELD(:) = IWORK(IWORK(2)+3:) +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_N1 +! +! +SUBROUTINE IO_READ_FIELD_LFI_N2(TPFILE,TPFIELD,KFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +INTEGER,DIMENSION(:,:),INTENT(OUT) :: KFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = SIZE(KFIELD) +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) KFIELD(:,:) = RESHAPE(IWORK(IWORK(2)+3:),SHAPE(KFIELD)) +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_N2 +! +! +SUBROUTINE IO_READ_FIELD_LFI_L0(TPFILE,TPFIELD,OFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD +LOGICAL, INTENT(OUT) :: OFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER :: IFIELD +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = 1 +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) THEN + IFIELD = IWORK(IWORK(2)+3) + IF (IFIELD==0) THEN + OFIELD = .FALSE. + ELSE IF (IFIELD==1) THEN + OFIELD = .TRUE. + ELSE + CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L0',TRIM(TPFILE%CNAME)//': invalid value in file for ' & + //TRIM(TPFIELD%CMNHNAME)) + OFIELD = .TRUE. + IRESP = -112 + END IF +END IF +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_L0 +! +! +SUBROUTINE IO_READ_FIELD_LFI_L1(TPFILE,TPFIELD,OFIELD,KRESP) +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +LOGICAL,DIMENSION(:),INTENT(OUT) :: OFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG +INTEGER :: JI +INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = SIZE(OFIELD) +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) THEN + IFIELD(:) = IWORK(IWORK(2)+3:) + DO JI=1,ILENG + IF (IFIELD(JI)==0) THEN + OFIELD(JI) = .FALSE. + ELSE IF (IFIELD(JI)==1) THEN + OFIELD(JI) = .TRUE. + ELSE + OFIELD(JI) = .TRUE. + IRESP = -112 + END IF + END DO + IF (IRESP==-112) THEN + CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L1',TRIM(TPFILE%CNAME)//': invalid value(s) in file for ' & + //TRIM(TPFIELD%CMNHNAME)) + END IF +END IF +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_L1 +! +! +SUBROUTINE IO_READ_FIELD_LFI_C0(TPFILE,TPFIELD,HFIELD,KRESP) +! +USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAXLFI +! +USE MODE_MSG +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD +CHARACTER(LEN=*),INTENT(OUT) :: HFIELD ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL +INTEGER :: ILENG, ILENGMAX, JLOOP +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +ILENG = LEN(HFIELD) +ILENGMAX = ILENG +! +!Special treatment for MY_NAME and DAD_NAME fields (for backward compatibility) +IF (TPFIELD%CMNHNAME=='MY_NAME' .OR. TPFIELD%CMNHNAME=='DAD_NAME') THEN + ILENG = MIN(LEN(HFIELD),NFILENAMELGTMAXLFI) + ILENGMAX = NFILENAMELGTMAXLFI + IF (LEN(HFIELD)<NFILENAMELGTMAXLFI) & + CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_FIELD_LFI_C0',TRIM(TPFILE%CNAME)// & + ': LEN(HFIELD)<NFILENAMELGTMAXLFI') +END IF +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENGMAX,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) THEN + DO JLOOP=1,ILENG + HFIELD(JLOOP:JLOOP)=ACHAR(IWORK(IWORK(2)+2+JLOOP)) + END DO +END IF +! +KRESP=IRESP +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +END SUBROUTINE IO_READ_FIELD_LFI_C0 +! +! +SUBROUTINE IO_READ_FIELD_LFI_T0(TPFILE,TPFIELD,TPDATA,KRESP) +! +USE MODE_MSG +USE MODD_TYPE_DATE +! +IMPLICIT NONE +! +!* 0.1 Declarations of arguments +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD +TYPE (DATE_TIME),INTENT(INOUT) :: TPDATA ! array containing the data field +INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured +! +!* 0.2 Declarations of local variables +! +INTEGER(KIND=LFI_INT) :: IRESP, ITOTAL +INTEGER :: ILENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK +LOGICAL :: GGOOD +TYPE(TFIELDDATA) :: TZFIELD +INTEGER, DIMENSION(3) :: ITDATE ! date array +REAL,DIMENSION(1) :: ZTIME +! +CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) +! +TZFIELD = TPFIELD +! +! Read date +! +TZFIELD%CMNHNAME = TRIM(TPFIELD%CMNHNAME)//'%TDATE' +TZFIELD%CCOMMENT = 'YYYYMMDD' +! +ILENG=SIZE(ITDATE) +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) THEN + TPDATA%TDATE%YEAR = IWORK(IWORK(2)+2+1) + TPDATA%TDATE%MONTH = IWORK(IWORK(2)+2+2) + TPDATA%TDATE%DAY = IWORK(IWORK(2)+2+3) +END IF +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +IF (.NOT.GGOOD) THEN + KRESP = IRESP + RETURN +END IF +! +! Read time +! +TZFIELD%CMNHNAME = TRIM(TPFIELD%CMNHNAME)//'%TIME' +TZFIELD%CCOMMENT = 'SECONDS' +! +ILENG=1 +! +CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) +! +IF (GGOOD) THEN + !TRANSFER_I8_R works with 1D arrays + ZTIME = TRANSFER_I8_R( (/ IWORK(IWORK(2)+3) /) ) + TPDATA%TIME = ZTIME(1) +END IF +! +IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) +! +KRESP = IRESP +! +END SUBROUTINE IO_READ_FIELD_LFI_T0 +! +! +SUBROUTINE IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,KLENG,KWORK,KTOTAL,KRESP,OGOOD) +! +USE MODD_PARAMETERS, ONLY: NGRIDUNKNOWN +! +TYPE(TFILEDATA), INTENT(IN) :: TPFILE +TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD +INTEGER, INTENT(IN) :: KLENG +INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KWORK +INTEGER(KIND=LFI_INT), INTENT(OUT) :: KTOTAL +INTEGER(KIND=LFI_INT), INTENT(OUT) :: KRESP +LOGICAL, INTENT(OUT) :: OGOOD +! +INTEGER :: IERRLEVEL,IROW,J +INTEGER,DIMENSION(JPXKRK) :: ICOMMENT +INTEGER(KIND=LFI_INT) :: ICOMLEN,INUMBR,IPOSEX +CHARACTER(LEN=:),ALLOCATABLE :: YMSG +CHARACTER(LEN=12) :: YRECLENGTH_FILE, YRECLENGTH_MEM +CHARACTER(LEN=12) :: YVAL_FILE, YVAL_MEM +CHARACTER(LEN=JPXKRK) :: YCOMMENT +CHARACTER(LEN=12) :: YRESP +CHARACTER(LEN=LEN_HREC) :: YRECFM +LOGICAL :: GOLDMNH !if old version of MesoNH (<5.4, old files without complete and correct metadata) +! +OGOOD = .TRUE. +! +GOLDMNH = TPFILE%NMNHVERSION(1)<5 .OR. (TPFILE%NMNHVERSION(1)==5 .AND. TPFILE%NMNHVERSION(2)<4) +! +YRECFM=TRIM(TPFIELD%CMNHNAME) +IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) & + CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI','field name was truncated to '& + //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME)) +! +!* 2.a LET'S GET SOME INFORMATION ON THE DESIRED ARTICLE +! +INUMBR = TPFILE%NLFIFLU +CALL LFINFO(KRESP,INUMBR,YRECFM,KTOTAL,IPOSEX) +! +IF (KRESP.NE.0) THEN + WRITE(YRESP, '( I12 )') KRESP + YMSG = 'RESP='//TRIM(ADJUSTL(YRESP))//' in call to LFINFO when reading '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME) + CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',YMSG) + OGOOD = .FALSE. + RETURN +ELSEIF (KTOTAL.EQ.0) THEN + CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': record length is zero for ' & + //TRIM(TPFIELD%CMNHNAME)) + KRESP=-47 + OGOOD = .FALSE. + RETURN +ELSEIF (KTOTAL.GT.JPXFIE) THEN + CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)// & + ': record length exceeds the maximum value in FM for '//TRIM(TPFIELD%CMNHNAME)) + KRESP=-48 + OGOOD = .FALSE. + RETURN +ENDIF +! +!* 2.b UNFORMATTED DIRECT ACCESS READ OPERATION +! +ALLOCATE(KWORK(KTOTAL)) +! +CALL LFILEC(KRESP,INUMBR,YRECFM,KWORK,KTOTAL) +IF (KRESP.NE.0) THEN + WRITE(YRESP, '( I12 )') KRESP + YMSG = 'RESP='//TRIM(ADJUSTL(YRESP))//' in call to LFILEC when reading '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME) + CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',YMSG) + OGOOD = .FALSE. + RETURN +ENDIF +! +!* 2.c THE GRID INDICATOR AND THE COMMENT STRING +!* ARE SEPARATED FROM THE DATA +! +ICOMLEN = KWORK(2) +IROW=KLENG+ICOMLEN+2 +IF (KTOTAL.NE.IROW) THEN + WRITE(YRECLENGTH_FILE,'(I12)') KTOTAL-2-ICOMLEN + WRITE(YRECLENGTH_MEM, '(I12)') KLENG + CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI','wrong field size for '//TRIM(TPFIELD%CMNHNAME) & + //' (expected: '//TRIM(ADJUSTL(YRECLENGTH_MEM))// & + ', in file: ' //TRIM(ADJUSTL(YRECLENGTH_FILE))//')') + KRESP=-63 + OGOOD = .FALSE. + RETURN +ENDIF +! +IF(TPFIELD%NGRID==NGRIDUNKNOWN) TPFIELD%NGRID=KWORK(1) +! +IF (KWORK(1)/=TPFIELD%NGRID) THEN + WRITE(YVAL_FILE,'(I12)') KWORK(1) + WRITE(YVAL_MEM, '(I12)') TPFIELD%NGRID + IF (TPFIELD%NDIMS==0 .OR. GOLDMNH) THEN + IERRLEVEL = NVERB_WARNING + ELSE + IERRLEVEL = NVERB_ERROR + END IF + CALL PRINT_MSG(IERRLEVEL,'IO','IO_READ_CHECK_FIELD_LFI','expected GRID value ('//TRIM(ADJUSTL(YVAL_MEM))// & + ') is different than found in file ('//TRIM(ADJUSTL(YVAL_FILE))//') for variable '//TRIM(TPFIELD%CMNHNAME)) + IF(.NOT.GOLDMNH) THEN !Do not modify probably incorrect grid number (to prevent problems later with other correct files) + TPFIELD%NGRID = KWORK(1) + KRESP = -111 !Used later to broadcast modified metadata + END IF +ELSE + CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_LFI','expected GRID found in file for field ' & + //TRIM(TPFIELD%CMNHNAME)) +ENDIF +! +YCOMMENT='' +SELECT CASE (ICOMLEN) +CASE(:-1) + CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': comment length is negative for ' & + //TRIM(TPFIELD%CMNHNAME)) + KRESP=-58 + OGOOD = .FALSE. + RETURN +CASE(0) + KRESP = 0 +CASE(1:JPXKRK) + ICOMMENT(1:ICOMLEN)=KWORK(3:ICOMLEN+2) + DO J=1,ICOMLEN + YCOMMENT(J:J)=CHAR(ICOMMENT(J)) + ENDDO +CASE(JPXKRK+1:) + CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': comment is too long in file for ' & + //TRIM(TPFIELD%CMNHNAME)) + KRESP=-56 + RETURN +END SELECT +! +IF (TRIM(YCOMMENT)/=TRIM(TPFIELD%CCOMMENT)) THEN + CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_LFI','expected COMMENT ('//TRIM(TPFIELD%CCOMMENT)// & + ') is different than found ('//TRIM(YCOMMENT)//') in file for field '//TRIM(TPFIELD%CMNHNAME)) + TPFIELD%CCOMMENT=TRIM(YCOMMENT) + KRESP = -111 !Used later to broadcast modified metadata +ELSE + CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_LFI','expected COMMENT found in file for field ' & + //TRIM(TPFIELD%CMNHNAME)) +END IF +! +END SUBROUTINE IO_READ_CHECK_FIELD_LFI +! +! +FUNCTION TRANSFER_I8_R(KFIELDIN) RESULT(PFIELDOUT) +! +INTEGER(KIND=8),DIMENSION(:),INTENT(IN) :: KFIELDIN +REAL,DIMENSION(SIZE(KFIELDIN)) :: PFIELDOUT +! +INTEGER :: ILENG +#if (MNH_REAL == 4) +REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: ZFIELD8 +#endif +! +ILENG = SIZE(PFIELDOUT) +! +#if (MNH_REAL == 8) + PFIELDOUT(:) = TRANSFER(KFIELDIN,PFIELDOUT(1),ILENG) +#else + ALLOCATE(ZFIELD8(ILENG)) + ZFIELD8(:) = TRANSFER(KFIELDIN,ZFIELD8(1),ILENG) + PFIELDOUT(:) = REAL(ZFIELD8(:),KIND=4) + DEALLOCATE(ZFIELD8) +#endif +! +END FUNCTION TRANSFER_I8_R + + +end module mode_io_read_lfi diff --git a/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90 index 8176017be08a616ab22b010951f926cc6b274e80..b5853626cda4c2f036cddf856520f884799a85ec 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90 @@ -13,7 +13,7 @@ module mode_io_read_nc4 use modd_io_ll, only: tfiledata -use modd_netcdf, only: idcdf_kind +use modd_netcdf, only: IDCDF_KIND use mode_field, only: tfielddata use mode_io_tools_nc4, only: cleanmnhname, handle_err diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools.f90 index ed80dcbe64e5edb250bdc8ce635e177f79221f4c..9e8dd1fc85b8dd0412cc535af1afa88752598c2b 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_tools.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_tools.f90 @@ -5,17 +5,17 @@ !----------------------------------------------------------------- ! Modifications: ! P. Wautelet : 13/12/2018 : extracted from mode_io.f90 +! P. Wautelet : 14/12/2018 : added io_construct_filename !----------------------------------------------------------------- module mode_io_tools -use mode_msg +use modd_io_ll, only: tfiledata implicit none private -public :: io_file, io_rank -public :: io_get_mnhversion, io_set_mnhversion +public :: io_file, io_rank, io_construct_filename contains @@ -63,6 +63,41 @@ contains END FUNCTION IO_RANK +subroutine io_construct_filename(tpfile,hfilem) + type(tfiledata), intent(inout) :: tpfile + character(len=:), allocatable, intent(out) :: hfilem + + if (allocated(tpfile%cdirname)) then + if(len_trim(tpfile%cdirname)>0) then + hfilem = trim(tpfile%cdirname)//'/'//trim(tpfile%cname) + else + hfilem = trim(tpfile%cname) + end if + else + hfilem = trim(tpfile%cname) + end if + +end subroutine io_construct_filename + + +end module mode_io_tools + + + +module mode_io_tools_mnhversion + +use modd_io_ll, only: tfiledata + +use mode_msg + +implicit none + +private + +public :: io_get_mnhversion, io_set_mnhversion + +contains + subroutine io_get_mnhversion(tpfile) !Compare MNHVERSION of file with current version and store it in file metadata use modd_conf, only: nmnhversion @@ -164,4 +199,4 @@ contains tpfile%nmnhversion(:) = nmnhversion(:) end subroutine io_set_mnhversion -end module mode_io_tools +end module mode_io_tools_mnhversion diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools_lfi.f90 new file mode 100644 index 0000000000000000000000000000000000000000..a55365550f8f8c0a0221da035e8315c2f2f487dc --- /dev/null +++ b/src/LIB/SURCOUCHE/src/mode_io_tools_lfi.f90 @@ -0,0 +1,44 @@ +!MNH_LIC Copyright 2018-2018 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. +!----------------------------------------------------------------- +! Creation: +! P. Wautelet : 14/12/2018 +!----------------------------------------------------------------- +module mode_io_tools_lfi + +use modd_io_ll, only: tfiledata + +implicit none + +private + +public :: io_prepare_verbosity_lfi + +contains + +subroutine io_prepare_verbosity_lfi(tpfile, kmelev, ostats) + type(tfiledata), intent(in) :: tpfile + integer(kind=LFI_INT), intent(out) :: kmelev + logical, intent(out) :: ostats + + select case (tpfile%nlfiverb) + case(:2) + ostats = .false. + kmelev = 0 + case(3:6) + ostats = .false. + kmelev = 1 + case(7:9) + ostats = .false. + kmelev = 2 + case(10:) + ostats = .true. + kmelev = 2 + end select + +end subroutine io_prepare_verbosity_lfi + + +end module mode_io_tools_lfi diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 index 4628accc37de20c60f5cacaa02e3a469254e9d8f..a0c53f5fb284f54c63c1fcb4751ef86536ce9baf 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 @@ -13,7 +13,7 @@ module mode_io_tools_nc4 use modd_io_ll, only: tfiledata -use modd_netcdf, only: dimcdf, idcdf_kind, iocdf, tdim_dummy +use modd_netcdf, only: dimcdf, IDCDF_KIND, iocdf, tdim_dummy use mode_field, only: tfielddata use mode_msg diff --git a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90 similarity index 51% rename from src/LIB/SURCOUCHE/src/fmreadwrit.f90 rename to src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90 index b0d3cc7e40622390228fa1760d313099ad00c597..0a14564b0ae2305c896a426c8e8a22199b1d84de 100644 --- a/src/LIB/SURCOUCHE/src/fmreadwrit.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90 @@ -1,12 +1,13 @@ !MNH_LIC Copyright 1994-2018 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. !----------------------------------------------------------------- -MODULE MODE_READWRITE_LFI +module mode_io_write_lfi ! Modifications: ! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O ! Philippe Wautelet: 21/06/2018: read and write correctly if MNH_REAL=4 +! Philippe Wautelet: 14/12/2018: split fmreadwrit.f90 ! USE MODD_IO_ll USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH @@ -21,18 +22,6 @@ PRIVATE INTEGER, PARAMETER :: JPXKRK = NLFIMAXCOMMENTLENGTH 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, & - IO_READ_FIELD_LFI_X4, IO_READ_FIELD_LFI_X5, & - IO_READ_FIELD_LFI_X6, & - IO_READ_FIELD_LFI_N0, IO_READ_FIELD_LFI_N1, & - IO_READ_FIELD_LFI_N2, & - IO_READ_FIELD_LFI_L0, IO_READ_FIELD_LFI_L1, & - IO_READ_FIELD_LFI_C0, & - IO_READ_FIELD_LFI_T0 -END INTERFACE IO_READ_FIELD_LFI -! INTERFACE IO_WRITE_FIELD_LFI MODULE PROCEDURE IO_WRITE_FIELD_LFI_X0,IO_WRITE_FIELD_LFI_X1, & IO_WRITE_FIELD_LFI_X2,IO_WRITE_FIELD_LFI_X3, & @@ -45,718 +34,10 @@ INTERFACE IO_WRITE_FIELD_LFI IO_WRITE_FIELD_LFI_T0 END INTERFACE IO_WRITE_FIELD_LFI ! -PUBLIC IO_READ_FIELD_LFI,IO_WRITE_FIELD_LFI +PUBLIC IO_WRITE_FIELD_LFI ! CONTAINS ! -SUBROUTINE IO_READ_FIELD_LFI_X0(TPFILE,TPFIELD,PFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -REAL, INTENT(OUT) :: PFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -REAL,DIMENSION(1) :: ZFIELD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = 1 -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) THEN - !TRANSFER_I8_R works with 1D arrays - ZFIELD = TRANSFER_I8_R( (/ IWORK(IWORK(2)+3) /) ) - PFIELD = ZFIELD(1) -END IF -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_X0 -! -! -SUBROUTINE IO_READ_FIELD_LFI_X1(TPFILE,TPFIELD,PFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -REAL,DIMENSION(:),INTENT(OUT) :: PFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = SIZE(PFIELD) -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) PFIELD = TRANSFER_I8_R(IWORK(IWORK(2)+3:)) -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_X1 -! -! -SUBROUTINE IO_READ_FIELD_LFI_X2(TPFILE,TPFIELD,PFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -REAL,DIMENSION(:,:),INTENT(OUT) :: PFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = SIZE(PFIELD) -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) ) -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_X2 -! -! -SUBROUTINE IO_READ_FIELD_LFI_X3(TPFILE,TPFIELD,PFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -REAL,DIMENSION(:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = SIZE(PFIELD) -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) ) -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_X3 -! -! -SUBROUTINE IO_READ_FIELD_LFI_X4(TPFILE,TPFIELD,PFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -REAL,DIMENSION(:,:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = SIZE(PFIELD) -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) ) -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_X4 -! -! -SUBROUTINE IO_READ_FIELD_LFI_X5(TPFILE,TPFIELD,PFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -REAL,DIMENSION(:,:,:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = SIZE(PFIELD) -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) ) -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_X5 -! -! -SUBROUTINE IO_READ_FIELD_LFI_X6(TPFILE,TPFIELD,PFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -REAL,DIMENSION(:,:,:,:,:,:),INTENT(OUT) :: PFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = SIZE(PFIELD) -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) PFIELD = RESHAPE( TRANSFER_I8_R(IWORK(IWORK(2)+3:)) , SHAPE(PFIELD) ) -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_X6 -! -! -SUBROUTINE IO_READ_FIELD_LFI_N0(TPFILE,TPFIELD,KFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD -INTEGER, INTENT(OUT) :: KFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = 1 -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) KFIELD = IWORK(IWORK(2)+3) -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_N0 -! -! -SUBROUTINE IO_READ_FIELD_LFI_N1(TPFILE,TPFIELD,KFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -INTEGER,DIMENSION(:),INTENT(OUT) :: KFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = SIZE(KFIELD) -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) KFIELD(:) = IWORK(IWORK(2)+3:) -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_N1 -! -! -SUBROUTINE IO_READ_FIELD_LFI_N2(TPFILE,TPFIELD,KFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -INTEGER,DIMENSION(:,:),INTENT(OUT) :: KFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = SIZE(KFIELD) -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) KFIELD(:,:) = RESHAPE(IWORK(IWORK(2)+3:),SHAPE(KFIELD)) -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_N2 -! -! -SUBROUTINE IO_READ_FIELD_LFI_L0(TPFILE,TPFIELD,OFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD -LOGICAL, INTENT(OUT) :: OFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER :: IFIELD -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = 1 -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) THEN - IFIELD = IWORK(IWORK(2)+3) - IF (IFIELD==0) THEN - OFIELD = .FALSE. - ELSE IF (IFIELD==1) THEN - OFIELD = .TRUE. - ELSE - CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L0',TRIM(TPFILE%CNAME)//': invalid value in file for ' & - //TRIM(TPFIELD%CMNHNAME)) - OFIELD = .TRUE. - IRESP = -112 - END IF -END IF -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_L0 -! -! -SUBROUTINE IO_READ_FIELD_LFI_L1(TPFILE,TPFIELD,OFIELD,KRESP) -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -LOGICAL,DIMENSION(:),INTENT(OUT) :: OFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG -INTEGER :: JI -INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = SIZE(OFIELD) -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) THEN - IFIELD(:) = IWORK(IWORK(2)+3:) - DO JI=1,ILENG - IF (IFIELD(JI)==0) THEN - OFIELD(JI) = .FALSE. - ELSE IF (IFIELD(JI)==1) THEN - OFIELD(JI) = .TRUE. - ELSE - OFIELD(JI) = .TRUE. - IRESP = -112 - END IF - END DO - IF (IRESP==-112) THEN - CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_FIELD_LFI_L1',TRIM(TPFILE%CNAME)//': invalid value(s) in file for ' & - //TRIM(TPFIELD%CMNHNAME)) - END IF -END IF -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_L1 -! -! -SUBROUTINE IO_READ_FIELD_LFI_C0(TPFILE,TPFIELD,HFIELD,KRESP) -! -USE MODD_PARAMETERS, ONLY: NFILENAMELGTMAXLFI -! -USE MODE_MSG -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD -CHARACTER(LEN=*),INTENT(OUT) :: HFIELD ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP,ITOTAL -INTEGER :: ILENG, ILENGMAX, JLOOP -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -ILENG = LEN(HFIELD) -ILENGMAX = ILENG -! -!Special treatment for MY_NAME and DAD_NAME fields (for backward compatibility) -IF (TPFIELD%CMNHNAME=='MY_NAME' .OR. TPFIELD%CMNHNAME=='DAD_NAME') THEN - ILENG = MIN(LEN(HFIELD),NFILENAMELGTMAXLFI) - ILENGMAX = NFILENAMELGTMAXLFI - IF (LEN(HFIELD)<NFILENAMELGTMAXLFI) & - CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_FIELD_LFI_C0',TRIM(TPFILE%CNAME)// & - ': LEN(HFIELD)<NFILENAMELGTMAXLFI') -END IF -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,ILENGMAX,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) THEN - DO JLOOP=1,ILENG - HFIELD(JLOOP:JLOOP)=ACHAR(IWORK(IWORK(2)+2+JLOOP)) - END DO -END IF -! -KRESP=IRESP -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -END SUBROUTINE IO_READ_FIELD_LFI_C0 -! -! -SUBROUTINE IO_READ_FIELD_LFI_T0(TPFILE,TPFIELD,TPDATA,KRESP) -! -USE MODE_MSG -USE MODD_TYPE_DATE -! -IMPLICIT NONE -! -!* 0.1 Declarations of arguments -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA),INTENT(INOUT) :: TPFIELD -TYPE (DATE_TIME),INTENT(INOUT) :: TPDATA ! array containing the data field -INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured -! -!* 0.2 Declarations of local variables -! -INTEGER(KIND=LFI_INT) :: IRESP, ITOTAL -INTEGER :: ILENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK -LOGICAL :: GGOOD -TYPE(TFIELDDATA) :: TZFIELD -INTEGER, DIMENSION(3) :: ITDATE ! date array -REAL,DIMENSION(1) :: ZTIME -! -CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_FIELD_LFI_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME)) -! -TZFIELD = TPFIELD -! -! Read date -! -TZFIELD%CMNHNAME = TRIM(TPFIELD%CMNHNAME)//'%TDATE' -TZFIELD%CCOMMENT = 'YYYYMMDD' -! -ILENG=SIZE(ITDATE) -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) THEN - TPDATA%TDATE%YEAR = IWORK(IWORK(2)+2+1) - TPDATA%TDATE%MONTH = IWORK(IWORK(2)+2+2) - TPDATA%TDATE%DAY = IWORK(IWORK(2)+2+3) -END IF -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -IF (.NOT.GGOOD) THEN - KRESP = IRESP - RETURN -END IF -! -! Read time -! -TZFIELD%CMNHNAME = TRIM(TPFIELD%CMNHNAME)//'%TIME' -TZFIELD%CCOMMENT = 'SECONDS' -! -ILENG=1 -! -CALL IO_READ_CHECK_FIELD_LFI(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD) -! -IF (GGOOD) THEN - !TRANSFER_I8_R works with 1D arrays - ZTIME = TRANSFER_I8_R( (/ IWORK(IWORK(2)+3) /) ) - TPDATA%TIME = ZTIME(1) -END IF -! -IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK) -! -KRESP = IRESP -! -END SUBROUTINE IO_READ_FIELD_LFI_T0 -! -! -SUBROUTINE IO_READ_CHECK_FIELD_LFI(TPFILE,TPFIELD,KLENG,KWORK,KTOTAL,KRESP,OGOOD) -! -USE MODD_PARAMETERS, ONLY: NGRIDUNKNOWN -! -TYPE(TFILEDATA), INTENT(IN) :: TPFILE -TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD -INTEGER, INTENT(IN) :: KLENG -INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KWORK -INTEGER(KIND=LFI_INT), INTENT(OUT) :: KTOTAL -INTEGER(KIND=LFI_INT), INTENT(OUT) :: KRESP -LOGICAL, INTENT(OUT) :: OGOOD -! -INTEGER :: IERRLEVEL,IROW,J -INTEGER,DIMENSION(JPXKRK) :: ICOMMENT -INTEGER(KIND=LFI_INT) :: ICOMLEN,INUMBR,IPOSEX -CHARACTER(LEN=:),ALLOCATABLE :: YMSG -CHARACTER(LEN=12) :: YRECLENGTH_FILE, YRECLENGTH_MEM -CHARACTER(LEN=12) :: YVAL_FILE, YVAL_MEM -CHARACTER(LEN=JPXKRK) :: YCOMMENT -CHARACTER(LEN=12) :: YRESP -CHARACTER(LEN=LEN_HREC) :: YRECFM -LOGICAL :: GOLDMNH !if old version of MesoNH (<5.4, old files without complete and correct metadata) -! -OGOOD = .TRUE. -! -GOLDMNH = TPFILE%NMNHVERSION(1)<5 .OR. (TPFILE%NMNHVERSION(1)==5 .AND. TPFILE%NMNHVERSION(2)<4) -! -YRECFM=TRIM(TPFIELD%CMNHNAME) -IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) & - CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI','field name was truncated to '& - //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME)) -! -!* 2.a LET'S GET SOME INFORMATION ON THE DESIRED ARTICLE -! -INUMBR = TPFILE%NLFIFLU -CALL LFINFO(KRESP,INUMBR,YRECFM,KTOTAL,IPOSEX) -! -IF (KRESP.NE.0) THEN - WRITE(YRESP, '( I12 )') KRESP - YMSG = 'RESP='//TRIM(ADJUSTL(YRESP))//' in call to LFINFO when reading '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME) - CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',YMSG) - OGOOD = .FALSE. - RETURN -ELSEIF (KTOTAL.EQ.0) THEN - CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': record length is zero for ' & - //TRIM(TPFIELD%CMNHNAME)) - KRESP=-47 - OGOOD = .FALSE. - RETURN -ELSEIF (KTOTAL.GT.JPXFIE) THEN - CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)// & - ': record length exceeds the maximum value in FM for '//TRIM(TPFIELD%CMNHNAME)) - KRESP=-48 - OGOOD = .FALSE. - RETURN -ENDIF -! -!* 2.b UNFORMATTED DIRECT ACCESS READ OPERATION -! -ALLOCATE(KWORK(KTOTAL)) -! -CALL LFILEC(KRESP,INUMBR,YRECFM,KWORK,KTOTAL) -IF (KRESP.NE.0) THEN - WRITE(YRESP, '( I12 )') KRESP - YMSG = 'RESP='//TRIM(ADJUSTL(YRESP))//' in call to LFILEC when reading '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME) - CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',YMSG) - OGOOD = .FALSE. - RETURN -ENDIF -! -!* 2.c THE GRID INDICATOR AND THE COMMENT STRING -!* ARE SEPARATED FROM THE DATA -! -ICOMLEN = KWORK(2) -IROW=KLENG+ICOMLEN+2 -IF (KTOTAL.NE.IROW) THEN - WRITE(YRECLENGTH_FILE,'(I12)') KTOTAL-2-ICOMLEN - WRITE(YRECLENGTH_MEM, '(I12)') KLENG - CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI','wrong field size for '//TRIM(TPFIELD%CMNHNAME) & - //' (expected: '//TRIM(ADJUSTL(YRECLENGTH_MEM))// & - ', in file: ' //TRIM(ADJUSTL(YRECLENGTH_FILE))//')') - KRESP=-63 - OGOOD = .FALSE. - RETURN -ENDIF -! -IF(TPFIELD%NGRID==NGRIDUNKNOWN) TPFIELD%NGRID=KWORK(1) -! -IF (KWORK(1)/=TPFIELD%NGRID) THEN - WRITE(YVAL_FILE,'(I12)') KWORK(1) - WRITE(YVAL_MEM, '(I12)') TPFIELD%NGRID - IF (TPFIELD%NDIMS==0 .OR. GOLDMNH) THEN - IERRLEVEL = NVERB_WARNING - ELSE - IERRLEVEL = NVERB_ERROR - END IF - CALL PRINT_MSG(IERRLEVEL,'IO','IO_READ_CHECK_FIELD_LFI','expected GRID value ('//TRIM(ADJUSTL(YVAL_MEM))// & - ') is different than found in file ('//TRIM(ADJUSTL(YVAL_FILE))//') for variable '//TRIM(TPFIELD%CMNHNAME)) - IF(.NOT.GOLDMNH) THEN !Do not modify probably incorrect grid number (to prevent problems later with other correct files) - TPFIELD%NGRID = KWORK(1) - KRESP = -111 !Used later to broadcast modified metadata - END IF -ELSE - CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_LFI','expected GRID found in file for field ' & - //TRIM(TPFIELD%CMNHNAME)) -ENDIF -! -YCOMMENT='' -SELECT CASE (ICOMLEN) -CASE(:-1) - CALL PRINT_MSG(NVERB_ERROR,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': comment length is negative for ' & - //TRIM(TPFIELD%CMNHNAME)) - KRESP=-58 - OGOOD = .FALSE. - RETURN -CASE(0) - KRESP = 0 -CASE(1:JPXKRK) - ICOMMENT(1:ICOMLEN)=KWORK(3:ICOMLEN+2) - DO J=1,ICOMLEN - YCOMMENT(J:J)=CHAR(ICOMMENT(J)) - ENDDO -CASE(JPXKRK+1:) - CALL PRINT_MSG(NVERB_WARNING,'IO','IO_READ_CHECK_FIELD_LFI',TRIM(TPFILE%CNAME)//': comment is too long in file for ' & - //TRIM(TPFIELD%CMNHNAME)) - KRESP=-56 - RETURN -END SELECT -! -IF (TRIM(YCOMMENT)/=TRIM(TPFIELD%CCOMMENT)) THEN - CALL PRINT_MSG(NVERB_INFO,'IO','IO_READ_CHECK_FIELD_LFI','expected COMMENT ('//TRIM(TPFIELD%CCOMMENT)// & - ') is different than found ('//TRIM(YCOMMENT)//') in file for field '//TRIM(TPFIELD%CMNHNAME)) - TPFIELD%CCOMMENT=TRIM(YCOMMENT) - KRESP = -111 !Used later to broadcast modified metadata -ELSE - CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_READ_CHECK_FIELD_LFI','expected COMMENT found in file for field ' & - //TRIM(TPFIELD%CMNHNAME)) -END IF -! -END SUBROUTINE IO_READ_CHECK_FIELD_LFI -! ! SUBROUTINE IO_WRITE_FIELD_LFI_X0(TPFILE,TPFIELD,PFIELD,KRESP) ! @@ -1504,28 +785,6 @@ ILENG = SIZE(PFIELDIN) #endif ! END SUBROUTINE TRANSFER_R_I8 -! -FUNCTION TRANSFER_I8_R(KFIELDIN) RESULT(PFIELDOUT) -! -INTEGER(KIND=8),DIMENSION(:),INTENT(IN) :: KFIELDIN -REAL,DIMENSION(SIZE(KFIELDIN)) :: PFIELDOUT -! -INTEGER :: ILENG -#if (MNH_REAL == 4) -REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: ZFIELD8 -#endif -! -ILENG = SIZE(PFIELDOUT) -! -#if (MNH_REAL == 8) - PFIELDOUT(:) = TRANSFER(KFIELDIN,PFIELDOUT(1),ILENG) -#else - ALLOCATE(ZFIELD8(ILENG)) - ZFIELD8(:) = TRANSFER(KFIELDIN,ZFIELD8(1),ILENG) - PFIELDOUT(:) = REAL(ZFIELD8(:),KIND=4) - DEALLOCATE(ZFIELD8) -#endif -! -END FUNCTION TRANSFER_I8_R -! -END MODULE MODE_READWRITE_LFI + + +end module mode_io_write_lfi diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 index ba49180c41248291d71fe5d2c4decb98316f559d..a95c75a371d803efb0d4ea61de1fe292770f4c41 100644 --- a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 @@ -13,7 +13,7 @@ module mode_io_write_nc4 use modd_io_ll, only: gsmonoproc, tfiledata -use modd_netcdf, only: dimcdf, idcdf_kind, iocdf +use modd_netcdf, only: dimcdf, IDCDF_KIND, iocdf use mode_field, only: tfielddata use mode_io_tools_nc4, only: cleanmnhname, fillvdims, getdimcdf, getstrdimid, handle_err @@ -45,8 +45,8 @@ END INTERFACE IO_WRITE_FIELD_NC4 integer,parameter :: NSTRINGCHUNKSIZE = 16 !Dimension of the chunks of strings !(to limit the number of dimensions for strings) -integer(kind=idcdf_kind),parameter :: SHUFFLE = 1 !Set to 1 for (usually) better compression -integer(kind=idcdf_kind),parameter :: DEFLATE = 1 +integer(kind=IDCDF_KIND),parameter :: SHUFFLE = 1 !Set to 1 for (usually) better compression +integer(kind=IDCDF_KIND),parameter :: DEFLATE = 1 contains diff --git a/src/LIB/SURCOUCHE/src/modi_io.f90 b/src/LIB/SURCOUCHE/src/modi_io.f90 index 7b1001be10ff637500eede7e15dce73902cdefdf..6136b47f52da70663b49023c77d9b6408fa83f66 100644 --- a/src/LIB/SURCOUCHE/src/modi_io.f90 +++ b/src/LIB/SURCOUCHE/src/modi_io.f90 @@ -27,7 +27,6 @@ INTERFACE DELIM, & PAD, & KNB_PROCIO,& - KMELEV,& OPARALLELIO, & HPROGRAM_ORIG) @@ -46,17 +45,15 @@ INTERFACE CHARACTER(len=*),INTENT(IN), OPTIONAL :: PAD INTEGER, INTENT(IN), OPTIONAL :: COMM INTEGER, INTENT(IN), OPTIONAL :: KNB_PROCIO - INTEGER(KIND=LFI_INT), INTENT(IN), OPTIONAL :: KMELEV LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO CHARACTER(LEN=*),INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program END SUBROUTINE OPEN_ll - - SUBROUTINE CLOSE_ll(TPFILE,IOSTAT,STATUS,OPARALLELIO,HPROGRAM_ORIG) + + SUBROUTINE CLOSE_ll(TPFILE,IOSTAT,OPARALLELIO,HPROGRAM_ORIG) USE MODD_IO_ll, ONLY : TFILEDATA TYPE(TFILEDATA), INTENT(IN) :: TPFILE INTEGER, INTENT(OUT), OPTIONAL :: IOSTAT - CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: STATUS LOGICAL, INTENT(IN), OPTIONAL :: OPARALLELIO CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: HPROGRAM_ORIG !To emulate a file coming from this program END SUBROUTINE CLOSE_ll