Newer
Older
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! PRINT *,'TYPEREAL --> ',tpreclist(ivar)%name,',len = ',idlen

WAUTELET Philippe
committed
idata(1:idlen) = RESHAPE( TRANSFER(xtab3d,(/ 0_8 /),idlen) , (/ idims(1)*idims(2)*idims(3) /) )
DEALLOCATE(xtab3d)
CASE(TYPECHAR)
status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,ytab)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
! PRINT *,'TYPECHAR --> ',tpreclist(ivar)%name,',len = ',idlen
DO jj=1,idlen
idata(jj) = ICHAR(ytab(jj))
END DO
DEALLOCATE(ytab)
CASE default

WAUTELET Philippe
committed
ALLOCATE( xtab3d(idims(1),idims(2),idims(3)) )
status = NF90_GET_VAR(kcdf_id,tpreclist(ivar)%id_in,xtab3d)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
PRINT *,'Default (ERROR) -->',tpreclist(ivar)%name,',len = ',idlen

WAUTELET Philippe
committed
idata(1:idlen) = RESHAPE( TRANSFER(xtab3d,(/ 0_8 /),idlen) , (/ idims(1)*idims(2)*idims(3) /) )
DEALLOCATE(xtab3d)
END SELECT
! Attention restoration des '%' dans le nom des champs LFI
yrecfm = str_replace(tpreclist(ivar)%name,'__','%')
! et des '.'
yrecfm = str_replace(yrecfm,'--','.')
iartlen8 = iartlen
CALL LFIECR(iresp,ilu,yrecfm,iwork,iartlen8)

WAUTELET Philippe
committed
DEALLOCATE(iwork)
END SUBROUTINE build_lfi
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
SUBROUTINE UPDATE_VARID_IN(infiles,hinfile,tpreclist,nbvar,current_level)
!Update the id_in for netCDF files (could change from one file to the other)
TYPE(filelist_struct), INTENT(IN) :: infiles
CHARACTER(LEN=*), INTENT(IN) :: hinfile
TYPE(workfield), DIMENSION(:), INTENT(INOUT) :: tpreclist
INTEGER, INTENT(IN) :: nbvar
INTEGER, INTENT(IN) :: current_level
INTEGER :: ji, status
CHARACTER(len=4) :: suffix
if (infiles%files(1)%format /= NETCDF_FORMAT) return
write(suffix,'(I4.4)') current_level
DO ji=1,nbvar
IF (.NOT.tpreclist(ji)%tbr) CYCLE
status = NF90_INQ_VARID(infiles%files(1)%lun_id,trim(tpreclist(ji)%name)//trim(suffix),tpreclist(ji)%id_in)
IF (status /= NF90_NOERR .AND. tpreclist(ji)%found) THEN
tpreclist(ji)%found=.false.
tpreclist(ji)%tbr=.false.
tpreclist(ji)%tbw=.false.
print *,'Error: variable ',trim(tpreclist(ji)%name),' not found anymore in split file'
END IF
END DO
END SUBROUTINE UPDATE_VARID_IN

WAUTELET Philippe
committed
SUBROUTINE OPEN_FILES(infiles,outfiles,hinfile,houtfile,nbvar_infile,options,runmode)

WAUTELET Philippe
committed
USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
USE MODD_GRID, ONLY: XBETA, XRPK, XLAT0, XLON0, XLATORI, XLONORI
USE MODD_GRID_n, ONLY: LSLEVE, XXHAT, XYHAT, XZHAT
USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT

WAUTELET Philippe
committed
USE MODE_FM, ONLY: IO_FILE_OPEN_ll, IO_FILE_CLOSE_ll
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_FILE_ADD2LIST
TYPE(filelist_struct),INTENT(OUT) :: infiles, outfiles
CHARACTER(LEN=*), INTENT(IN) :: hinfile
CHARACTER(LEN=*), INTENT(IN) :: houtfile

WAUTELET Philippe
committed
TYPE(option),DIMENSION(:),INTENT(IN) :: options
INTEGER , INTENT(IN) :: runmode

WAUTELET Philippe
committed
INTEGER :: IRESP

WAUTELET Philippe
committed
INTEGER(KIND=LFI_INT) :: ilu,iresp2,iverb,inap,inaf
CHARACTER(LEN=4) :: ypextsrc, ypextdest
LOGICAL :: fexist
INTEGER :: omode
iverb = 0

WAUTELET Philippe
committed
IF (runmode == MODELFI2CDF) THEN
infiles%nbfiles = infiles%nbfiles + 1
idx = infiles%nbfiles

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(INFILES%TFILES(idx)%TFILE,HINFILE(1:LEN_TRIM(HINFILE)-4),'UNKNOWN','READ', &
HFORMAT='LFI',KLFIVERB=0)
CALL IO_FILE_OPEN_ll(INFILES%TFILES(idx)%TFILE)
infiles%files(idx)%lun_id = INFILES%TFILES(idx)%TFILE%NLFIFLU
infiles%files(idx)%format = LFI_FORMAT
infiles%files(idx)%status = READING
ilu = infiles%files(idx)%lun_id

WAUTELET Philippe
committed
nbvar_infile = INFILES%TFILES(idx)%TFILE%NLFININAR

WAUTELET Philippe
committed
IF (options(OPTLIST)%set) THEN

WAUTELET Philippe
committed
CALL LFILAF(iresp2,ilu,lfalse)

WAUTELET Philippe
committed
CALL IO_FILE_CLOSE_ll(INFILES%TFILES(idx)%TFILE)

WAUTELET Philippe
committed
END IF

WAUTELET Philippe
committed
!Read problem dimensions and some grid variables (needed by IO_FILE_OPEN_ll for netCDF files)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'JPHEXT',JPHEXT)
!CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'JPVEXT',JPVEXT,IRESP)
!IF(IRESP/=0) JPVEXT=1
JPVEXT = 1

WAUTELET Philippe
committed
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
!
ALLOCATE(NIMAX_ll,NJMAX_ll,NKMAX)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'IMAX',NIMAX_ll)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'JMAX',NJMAX_ll)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'KMAX',NKMAX)
!
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'PROGRAM',CPROGRAM_ORIG)
!
ALLOCATE(CSTORAGE_TYPE)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'STORAGE_TYPE',CSTORAGE_TYPE)
!
IF ( TRIM(CPROGRAM_ORIG)/='PGD' &
.AND. .NOT.(TRIM(CPROGRAM_ORIG)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
ALLOCATE(XXHAT(NIMAX_ll+2*JPHEXT))
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'XHAT',XXHAT)
ALLOCATE(XYHAT(NJMAX_ll+2*JPHEXT))
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'YHAT',XYHAT)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'CARTESIAN',LCARTESIAN)
!
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'LAT0',XLAT0)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'LON0',XLON0)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'BETA',XBETA)
!
IF (.NOT.LCARTESIAN) THEN
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'RPK', XRPK)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'LATORI',XLATORI)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'LONORI',XLONORI)
ENDIF
!
IF (TRIM(CPROGRAM_ORIG)/='NESPGD') THEN
ALLOCATE(XZHAT(NKMAX+2*JPVEXT))
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'ZHAT',XZHAT)
ALLOCATE(LSLEVE)
CALL IO_READ_FIELD(INFILES%TFILES(idx)%TFILE,'SLEVE',LSLEVE)
END IF
END IF

WAUTELET Philippe
committed
IF (.NOT.options(OPTSPLIT)%set) THEN

WAUTELET Philippe
committed

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(OUTFILES%TFILES(idx)%TFILE,HOUTFILE,'UNKNOWN','WRITE', &
HFORMAT='NETCDF4')
CALL IO_FILE_OPEN_ll(OUTFILES%TFILES(idx)%TFILE,HPROGRAM_ORIG=CPROGRAM_ORIG)
outfiles%files(idx)%lun_id = OUTFILES%TFILES(idx)%TFILE%NNCID
outfiles%files(idx)%format = NETCDF_FORMAT
outfiles%files(idx)%status = WRITING
outfiles%files(idx)%opened = .TRUE.
status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)

WAUTELET Philippe
committed
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
!!$ CASE (NF90_FILL)
!!$ PRINT *,'Ancien mode : NF90_FILL'
!!$ CASE (NF90_NOFILL)
!!$ PRINT *,'Ancien mode : NF90_NOFILL'
!!$ CASE default
!!$ PRINT *, 'Ancien mode : inconnu'
!!$ END SELECT

WAUTELET Philippe
committed
END IF ! .NOT.osplit

WAUTELET Philippe
committed
ELSE IF (runmode == MODECDF2CDF) THEN
! Cas netCDF -> netCDF
infiles%nbfiles = infiles%nbfiles + 1
idx = infiles%nbfiles
status = NF90_OPEN(hinfile,NF90_NOWRITE,infiles%files(idx)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
infiles%files(idx)%opened = .TRUE.
infiles%files(idx)%format = NETCDF_FORMAT
infiles%files(idx)%status = READING
status = NF90_INQUIRE(infiles%files(idx)%lun_id, nvariables = nbvar_infile)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)

WAUTELET Philippe
committed
IF (.NOT.options(OPTSPLIT)%set) THEN
outfiles%nbfiles = outfiles%nbfiles + 1
idx = outfiles%nbfiles
status = NF90_CREATE(houtfile, IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
outfiles%files(idx)%opened = .TRUE.
outfiles%files(idx)%format = NETCDF_FORMAT
outfiles%files(idx)%status = WRITING
status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END IF ! .NOT.osplit
infiles%nbfiles = infiles%nbfiles + 1
idx = infiles%nbfiles
status = NF90_OPEN(hinfile,NF90_NOWRITE,infiles%files(idx)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
infiles%files(idx)%opened = .TRUE.
infiles%files(idx)%format = NETCDF_FORMAT
infiles%files(idx)%status = READING
status = NF90_INQUIRE(infiles%files(idx)%lun_id, nvariables = nbvar_infile)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
outfiles%nbfiles = outfiles%nbfiles + 1
idx = outfiles%nbfiles
outfiles%files(idx)%lun_id = 11
outfiles%files(idx)%format = LFI_FORMAT
outfiles%files(idx)%status = WRITING
ilu = outfiles%files(idx)%lun_id

WAUTELET Philippe
committed
CALL LFIOUV(iresp2,ilu,ltrue,TRIM(houtfile)//'.lfi','NEW' ,lfalse,lfalse,iverb,inap,inaf)
PRINT *,'--> Fichier converti : ', TRIM(houtfile)

WAUTELET Philippe
committed
SUBROUTINE OPEN_SPLIT_LFIFILE_IN(infiles,hinfile,current_level)
TYPE(filelist_struct), INTENT(INOUT) :: infiles

WAUTELET Philippe
committed
CHARACTER(LEN=*), INTENT(IN) :: hinfile
INTEGER, INTENT(IN) :: current_level
INTEGER(KIND=LFI_INT) :: ilu,iresp,iverb,inap,nbvar

WAUTELET Philippe
committed
CHARACTER(LEN=3) :: suffix
CHARACTER(LEN=:),ALLOCATABLE :: filename

WAUTELET Philippe
committed
iverb = 0 !Verbosity level for LFI
ALLOCATE(character(len=len(hinfile)) :: filename)
ilu = infiles%files(1)%lun_id !We assume only 1 infile

WAUTELET Philippe
committed
write(suffix,'(I3.3)') current_level
filename=hinfile(1:len(hinfile)-7)//suffix//'.lfi'
CALL LFIOUV(iresp,ilu,ltrue,filename,'OLD',lfalse,lfalse,iverb,inap,nbvar)
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
infiles%files(1)%opened = .TRUE.
DEALLOCATE(filename)
END SUBROUTINE OPEN_SPLIT_LFIFILE_IN
SUBROUTINE OPEN_SPLIT_NCFILE_IN(infiles,hinfile,current_level)
TYPE(filelist_struct), INTENT(INOUT) :: infiles
CHARACTER(LEN=*), INTENT(IN) :: hinfile
INTEGER, INTENT(IN) :: current_level
INTEGER :: status
CHARACTER(LEN=3) :: suffix
CHARACTER(LEN=:),ALLOCATABLE :: filename
ALLOCATE(character(len=len(hinfile)) :: filename)
write(suffix,'(I3.3)') current_level
filename=hinfile(1:len(hinfile)-6)//suffix//'.nc'
status = NF90_OPEN(filename,NF90_NOWRITE,infiles%files(1)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
infiles%files(1)%opened = .TRUE.

WAUTELET Philippe
committed
DEALLOCATE(filename)

WAUTELET Philippe
committed

WAUTELET Philippe
committed
SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,houtfile,nbvar,tpreclist,options)
TYPE(filelist_struct), INTENT(INOUT) :: outfiles

WAUTELET Philippe
committed
CHARACTER(LEN=*), INTENT(IN) :: houtfile
INTEGER, INTENT(IN) :: nbvar
TYPE(workfield), DIMENSION(:), INTENT(IN) :: tpreclist

WAUTELET Philippe
committed
TYPE(option),DIMENSION(:), INTENT(IN) :: options

WAUTELET Philippe
committed
INTEGER :: ji, idx
INTEGER :: status
INTEGER :: omode
CHARACTER(LEN=MAXLEN) :: filename
DO ji = 1,nbvar
IF (tpreclist(ji)%tbw) outfiles%nbfiles = outfiles%nbfiles + 1

WAUTELET Philippe
committed
END DO
idx = 1
DO ji = 1,nbvar
IF (.NOT.tpreclist(ji)%tbw) CYCLE

WAUTELET Philippe
committed
filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc'
status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id)

WAUTELET Philippe
committed
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)

WAUTELET Philippe
committed
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
outfiles%files(idx)%opened = .TRUE.
outfiles%files(idx)%format = NETCDF_FORMAT
outfiles%files(idx)%status = WRITING

WAUTELET Philippe
committed
idx = idx + 1
END DO
SUBROUTINE CLOSE_FILES(filelist)
TYPE(filelist_struct),INTENT(INOUT) :: filelist
INTEGER(KIND=LFI_INT) :: ilu,iresp

WAUTELET Philippe
committed
INTEGER :: ji,status
DO ji=1,filelist%nbfiles
IF ( .NOT.filelist%files(ji)%opened ) CYCLE
IF ( filelist%files(ji)%format == LFI_FORMAT ) THEN
ilu = filelist%files(ji)%lun_id
CALL LFIFER(iresp,ilu,'KEEP')
ELSE IF ( filelist%files(ji)%format == NETCDF_FORMAT ) THEN
status = NF90_CLOSE(filelist%files(ji)%lun_id)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
END IF
filelist%files(ji)%opened=.false.

WAUTELET Philippe
committed
END DO

WAUTELET Philippe
committed

WAUTELET Philippe
committed