Skip to content
Snippets Groups Projects
mode_util.f90 50.9 KiB
Newer Older
  • Learn to ignore specific revisions
  •           IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
    
    !          PRINT *,'TYPEREAL -->    ',tpreclist(ivar)%name,',len = ',idlen
    
              idata(1:idlen) = RESHAPE( TRANSFER(xtab3d,(/ 0_8 /),idlen) , (/ idims(1)*idims(2)*idims(3) /) )
    
              DEALLOCATE(xtab3d)
    
              ALLOCATE(ytab(idlen))
    
              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
    
              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
    
              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)
    
    
      END SUBROUTINE build_lfi
    
    
      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
    
    
      SUBROUTINE OPEN_FILES(infiles,outfiles,hinfile,houtfile,nbvar_infile,options,runmode)
    
        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
    
    
        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
    
        INTEGER         , INTENT(OUT) :: nbvar_infile
    
        TYPE(option),DIMENSION(:),INTENT(IN) :: options
        INTEGER         , INTENT(IN)  :: runmode
    
        INTEGER                     :: extindex
    
        INTEGER(KIND=LFI_INT)       :: ilu,iresp2,iverb,inap,inaf
    
        INTEGER                     :: idx,status
    
        CHARACTER(LEN=4)            :: ypextsrc, ypextdest
        LOGICAL                     :: fexist
        INTEGER                     :: omode
    
        iverb = 0
    
        CALL init_sysfield()
    
    
           ! Cas LFI -> NetCDF
    
           infiles%nbfiles = infiles%nbfiles + 1
           idx = infiles%nbfiles
    
           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
    
           infiles%files(idx)%opened  = .TRUE.
    
    
           nbvar_infile = INFILES%TFILES(idx)%TFILE%NLFININAR
    
              CALL IO_FILE_CLOSE_ll(INFILES%TFILES(idx)%TFILE)
    
           !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
    
           !
           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%nbfiles = outfiles%nbfiles + 1
    
             idx = outfiles%nbfiles
    
             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)
    
             IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
    
    !!$       SELECT CASE(omode)
    
    !!$       CASE (NF90_FILL)
    !!$          PRINT *,'Ancien mode : NF90_FILL'
    !!$       CASE (NF90_NOFILL)
    !!$          PRINT *,'Ancien mode : NF90_NOFILL'
    
    !!$       CASE default
    !!$          PRINT *, 'Ancien mode : inconnu'
    !!$       END SELECT
    
           ! 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__)
    
    
    
             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
    
    
        ELSE
           ! Cas NetCDF -> LFI
    
           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
    
           CALL LFIOUV(iresp2,ilu,ltrue,TRIM(houtfile)//'.lfi','NEW' ,lfalse,lfalse,iverb,inap,inaf)
    
           outfiles%files(idx)%opened  = .TRUE.
    
        PRINT *,'--> Fichier converti : ', TRIM(houtfile)
    
    
      END SUBROUTINE OPEN_FILES
    
      SUBROUTINE OPEN_SPLIT_LFIFILE_IN(infiles,hinfile,current_level)
        TYPE(filelist_struct), INTENT(INOUT) :: infiles
    
        CHARACTER(LEN=*), INTENT(IN) :: hinfile
        INTEGER,          INTENT(IN) :: current_level
    
    
        INTEGER(KIND=LFI_INT) :: ilu,iresp,iverb,inap,nbvar
    
    
        CHARACTER(LEN=3)      :: suffix
        CHARACTER(LEN=:),ALLOCATABLE :: filename
    
    
        iverb = 0 !Verbosity level for LFI
    
        ALLOCATE(character(len=len(hinfile)) :: filename)
    
    
        ilu = infiles%files(1)%lun_id !We assume only 1 infile
    
    
        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)
    
        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.
    
      END SUBROUTINE OPEN_SPLIT_NCFILE_IN
    
      SUBROUTINE OPEN_SPLIT_NCFILES_OUT(outfiles,houtfile,nbvar,tpreclist,options)
    
        TYPE(filelist_struct),         INTENT(INOUT) :: outfiles
    
        CHARACTER(LEN=*),              INTENT(IN)    :: houtfile
        INTEGER,                       INTENT(IN)    :: nbvar
        TYPE(workfield), DIMENSION(:), INTENT(IN)    :: tpreclist
    
        TYPE(option),DIMENSION(:),     INTENT(IN)    :: options
    
    
        INTEGER :: ji, idx
        INTEGER :: status
        INTEGER :: omode
        CHARACTER(LEN=MAXLEN) :: filename
    
    
        DO ji = 1,nbvar
    
          IF (tpreclist(ji)%tbw) outfiles%nbfiles = outfiles%nbfiles + 1
    
        END DO
    
        idx = 1
        DO ji = 1,nbvar
          IF (.NOT.tpreclist(ji)%tbw) CYCLE
    
          outfiles%files(idx)%var_id = ji
    
          filename = trim(houtfile)//'.'//trim(tpreclist(ji)%name)//'.nc'
          status = NF90_CREATE(trim(filename), IOR(NF90_CLOBBER,NF90_NETCDF4), outfiles%files(idx)%lun_id)
    
          IF (status /= NF90_NOERR) CALL HANDLE_ERR(status,__LINE__)
    
    
          status = NF90_SET_FILL(outfiles%files(idx)%lun_id,NF90_NOFILL,omode)
    
          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
    
    
      END SUBROUTINE OPEN_SPLIT_NCFILES_OUT
    
      SUBROUTINE CLOSE_FILES(filelist)
        TYPE(filelist_struct),INTENT(INOUT) :: filelist
    
        INTEGER(KIND=LFI_INT) :: ilu,iresp
    
        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.
    
      END SUBROUTINE CLOSE_FILES
    
    END MODULE mode_util