Newer
Older
iwork(2) = icomlen
DO jj=1,iwork(2)

WAUTELET Philippe
committed
iwork(2+jj)=ICHAR(tpreclist(ivar)%TFIELD%CCOMMENT(jj:jj))

WAUTELET Philippe
committed
stop
#if 0
IF (ASSOCIATED(tpreclist(ivar)%dim)) THEN
idlen = tpreclist(ivar)%dim%len

WAUTELET Philippe
committed
ndims = tpreclist(ivar)%dim%ndims

WAUTELET Philippe
committed
ndims = 0

WAUTELET Philippe
committed
idims(:) = 1
if(ndims>0) idims(1) = ptdimx%len
if(ndims>1) idims(2) = ptdimy%len
if(ndims>2) idims(3) = ptdimz%len
if(ndims>3) then
PRINT *,'Too many dimensions'
STOP
endif
iartlen = 2+icomlen+idlen
idata=>iwork(3+icomlen:iartlen)

WAUTELET Philippe
committed
SELECT CASE(tpreclist(ivar)%TFIELD%NTYPE)
CASE(TYPEINT,TYPELOG)

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

WAUTELET Philippe
committed
idata(1:idlen) = RESHAPE( itab3d , (/ idims(1)*idims(2)*idims(3) /) )
DEALLOCATE(itab3d)
CASE(TYPEREAL)

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 *,'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)

WAUTELET Philippe
committed
#endif
! 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
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
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

WAUTELET Philippe
committed
USE MODD_IO_ll, ONLY: LIOCDF4

WAUTELET Philippe
committed
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
!
! Infiles
!
IF (runmode == MODECDF2CDF .OR. runmode == MODECDF2LFI) THEN
!
! NetCDF
!
infiles%nbfiles = infiles%nbfiles + 1
idx = infiles%nbfiles
CALL IO_FILE_ADD2LIST(INFILES%TFILES(idx)%TFILE,HINFILE,'UNKNOWN','READ',HFORMAT='NETCDF4')
CALL IO_FILE_OPEN_ll(INFILES%TFILES(idx)%TFILE)
infiles%files(idx)%lun_id = INFILES%TFILES(idx)%TFILE%NNCID
infiles%files(idx)%format = NETCDF_FORMAT
infiles%files(idx)%status = READING
infiles%files(idx)%opened = .TRUE.

WAUTELET Philippe
committed
status = NF90_INQUIRE(infiles%files(idx)%lun_id, nvariables = nbvar_infile)
IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
ELSE
!
! LFI
!
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
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
END IF
!
!Read problem dimensions and some grid variables (needed by IO_FILE_OPEN_ll to create netCDF files but also to determine IDIMX/Y/Z)
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
!
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
!
! Outfiles
!
IF (runmode == MODELFI2CDF .OR. runmode == MODECDF2CDF) THEN

WAUTELET Philippe
committed
!

WAUTELET Philippe
committed
! NetCDF

WAUTELET Philippe
committed
!

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.

WAUTELET Philippe
committed
IF (options(OPTCOMPRESS)%set) THEN
outfiles%tfiles(idx)%tfile%LNCCOMPRESS = .TRUE.
outfiles%tfiles(idx)%tfile%NNCCOMPRESS_LEVEL = options(OPTCOMPRESS)%ivalue
END IF

WAUTELET Philippe
committed
IF (options(OPTREDUCE)%set) THEN
outfiles%tfiles(idx)%tfile%LNCREDUCE_FLOAT_PRECISION = .TRUE.
END IF
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

WAUTELET Philippe
committed
!
! LFI
!
outfiles%nbfiles = outfiles%nbfiles + 1
idx = outfiles%nbfiles

WAUTELET Philippe
committed
CALL IO_FILE_ADD2LIST(OUTFILES%TFILES(idx)%TFILE,TRIM(houtfile)//'.lfi','UNKNOWN','WRITE', &
HFORMAT='LFI',KLFIVERB=0)
LIOCDF4 = .FALSE. !Necessary to open correctly the LFI file
CALL IO_FILE_OPEN_ll(OUTFILES%TFILES(idx)%TFILE)
LIOCDF4 = .TRUE.
outfiles%files(idx)%lun_id = OUTFILES%TFILES(idx)%TFILE%NLFIFLU
outfiles%files(idx)%format = LFI_FORMAT
outfiles%files(idx)%status = WRITING

WAUTELET Philippe
committed
infiles%files(idx)%opened = .TRUE.
END IF

WAUTELET Philippe
committed
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)
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
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