Changeset 1655 in lmdz_wrf for trunk/tools


Ignore:
Timestamp:
Sep 27, 2017, 3:43:31 PM (8 years ago)
Author:
lfita
Message:

Adding new structure with module_basic.f90 and infrastructure to deal with netCDF from FORTRAN

Location:
trunk/tools
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/tools/Makefile.llamp

    r1614 r1655  
    2222
    2323# Sources for f2py
    24 distrisrcs = module_definitions.f90 module_generic.f90 module_scientific.f90 module_DistriCorrection.f90
    25 diagsrcs = module_definitions.f90 module_generic.f90 module_scientific.f90 module_ForDiagnosticsVars.f90 module_ForDiagnostics.f90
    26 intsrcs = module_definitions.f90 module_generic.f90 module_scientific.f90 module_ForInterpolate.f90
    27 scisrcs = module_definitions.f90 module_generic.f90 module_scientific.f90
     24srcs = module_definitions.f90 module_basic.f90 module_generic.f90 module_scientific.f90
     25distrisrcs = $(srcs) module_DistriCorrection.f90
     26diagsrcs = $(srcs) module_ForDiagnosticsVars.f90 module_ForDiagnostics.f90
     27intsrcs = $(srcs) module_ForInterpolate.f90
     28scisrcs = $(srcs)
    2829
    2930####### ###### ##### #### ### ## #
    … …  
    3132MODULES = \
    3233        module_definitions.o \
     34        module_basic.o \
     35        module_generic.o \
    3336        module_scientific.o \
    34         module_generic.o \
    3537        module_ForDiagnosticsVars.o \
    3638        module_ForDiagnostics.o \
    … …  
    4446        pydiagmods.o \
    4547        pyintmods.o \
    46         pyscimods.o
     48        pyscimods.o \
     49        trajectories_overlap.o
    4750
    4851diags : \
    … …  
    5962        $(FC) $(FCFLAGS) module_definitions.f90
    6063
    61 module_generic.o: module_definitions.o
     64module_basic.o: module_definitions.o
     65        $(FC) $(FCFLAGS) module_basic.f90
     66
     67module_generic.o: module_definitions.o module_basic.o
    6268        $(FC) $(FCFLAGS) $(LIB_NETCDF) $(LIB_INC) module_generic.f90
    6369
    64 module_scientific.o: module_definitions.o module_generic.o
    65         $(FC) $(FCFLAGS) module_scientific.f90
     70module_scientific.o: module_definitions.o module_basic.o module_generic.o
     71        $(FC) $(FCFLAGS) $(LIB_NETCDF) module_scientific.f90
    6672
    67 module_ForDiagnosticsVars.o: module_definitions.o module_generic.o
    68         $(FC) $(FCFLAGS) $(LIB_INC) module_ForDiagnosticsVars.f90
     73module_ForDiagnosticsVars.o: module_definitions.o module_basic.o module_generic.o
     74        $(FC) $(FCFLAGS) $(LIB_NETCDF) $(LIB_INC) module_ForDiagnosticsVars.f90
    6975
    70 module_ForDiagnostics.o: module_definitions.o module_generic.o module_ForDiagnosticsVars.o
    71         $(FC) $(FCFLAGS) $(LIB_INC) module_ForDiagnostics.f90
     76module_ForDiagnostics.o: module_definitions.o module_basic.o module_generic.o module_ForDiagnosticsVars.o
     77        $(FC) $(FCFLAGS) $(LIB_NETCDF) $(LIB_INC) module_ForDiagnostics.f90
    7278
    73 module_DistriCorrection.o: module_definitions.o module_generic.o module_scientific.o
     79module_DistriCorrection.o: module_definitions.o module_basic.o module_generic.o module_scientific.o
    7480        $(FC) $(FCFLAGS) $(LIB_NETCDF) module_DistriCorrection.f90
    7581
    7682FCEXECFLAGS = $(MODULES) $(LIB_NETCDF) $(LIB_INC)
    7783
    78 interpolate.o: module_definitions.o module_generic.o module_scientific.o
     84interpolate.o: module_definitions.o module_basic.o module_generic.o module_scientific.o
    7985        $(FC) $(FCEXECFLAGS) interpolate.f90 -o interpolate
    8086
    81 DistriCorrection.o: module_definitions.o module_generic.o module_scientific.o module_DistriCorrection.o
     87DistriCorrection.o: module_definitions.o module_basic.o module_generic.o module_scientific.o module_DistriCorrection.o
    8288        $(FC) $(FCEXECFLAGS) DistriCorrection.f90 -o DistriCorrection
    8389
    8490pydistrimods.o:
    85         f2py -c -m module_ForDistriCorrect $(distrisrcs)
     91        f2py -c $(NCINCFOLD) -m module_ForDistriCorrect $(distrisrcs)
    8692
    8793pydiagmods.o:
    88         f2py -c -m module_ForDiag $(diagsrcs)
     94        f2py -c $(NCINCFOLD) -m module_ForDiag $(diagsrcs)
    8995
    9096pyintmods.o:
    91         f2py -c -m module_ForInt $(intsrcs)
     97        f2py -c $(NCINCFOLD) -m module_ForInt $(intsrcs)
    9298
    9399pyscimods.o:
    94         f2py -c -m module_ForSci $(scisrcs)
     100        f2py -c $(NCINCFOLD) -m module_ForSci $(scisrcs)
    95101
     102trajectories_overlap.o: module_definitions.o module_basic.o module_generic.o module_scientific.o
     103        $(FC) $(FCEXECFLAGS) trajectories_overlap.f90 -o trajectories_overlap
     104

  • trunk/tools/module_definitions.f90

    r1654 r1655  
    66  REAL(r_k), PARAMETER                                   :: oneRK = 1.
    77  REAL(r_k), PARAMETER                                   :: twoRK = 2.
    8   REAL(r_k), PARAMETER                                   :: DegRad = 180.d0/ACOS(-1.)
     8  !REAL(r_k), PARAMETER                                   :: DegRad = 180.d0/DACOS(-1.)
     9  REAL(r_k), PARAMETER                                   :: DegRad = 180./ACOS(-1.)
    910  CHARACTER(len=100)                                     :: infomsg = 'INFORMATION -- information' // &
    1011    ' -- INFORMATION -- information'
    … …  
    1314  CHARACTER(len=50)                                      :: emsg = 'ERROR -- error -- ERROR -- error'
    1415  ! Fill value at 64 bits
     16  !REAL(r_k)                                              :: fillval64 = 1.d20
    1517  REAL(r_k)                                              :: fillval64 = 1.e20
    1618  INTEGER                                                :: fillvalI = -99999

  • trunk/tools/module_generic.f90

    r1653 r1655  
    33
    44!!!!!!! Subroutines/Functions
    5 ! ErrMsg: Subroutine to stop execution and provide an error message
    6 ! ErrWarnMsg: Function to print error/warning message
     5! freeunit: provides the number of a free unit in which open a file
     6! GetInNamelist: Subroutine to get a paramter from a namelistfile
    77! index_list_coordsI: Function to provide the index of a given coordinate within a list of integer coordinates
    88! Index1DArrayI: Function to provide the first index of a given value inside a 1D integer array
    … …  
    1212! Index2DArrayR_K: Function to provide the first index of a given value inside a 2D real(r_k) array
    1313! mat2DPosition: Function to provide the i, j indices of a given value inside a 2D matrix
    14 ! Nstrings: Function to repeat a number of times a given string
    1514! RangeI: Function to provide a range of d1 values from 'iniv' to 'endv', of integer values in a vector
    1615! RangeR: Function to provide a range of d1 values from 'iniv' to 'endv', of real values in a vector
    1716! RangeR_K: Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector
    18 ! split: Subroutine which provides the values from a string [String] which has been split by a given
    19 !   character [charv] a given number of values [Nvalues] is expected
    20 ! vectorR_KS: Function to transform a vector of reals to a string of characters
     17! stoprun: Subroutine to stop running and print a message
     18! netCDF related
     19!!!
     20! create_NCfile: Subroutine to create a netCDF file
     21! isin_file: Function to tell if a given variable is inside a file
     22! isin_ncunit: Function to tell if a given variable is inside a netcdf file unit
     23! get_var2dims_file: Function to get the dimensions of a given 2D variable inside a file
     24! get_var3dims_file: Function to get the dimensions of a given 3D variable inside a file
     25! get_var4dims_file: Function to get the dimensions of a given 4D variable inside a file
     26! get_var1dims_ncunit: Function to get the dimensions of a given 1D variable inside a unit of a netCDF file
     27! get_var2dims_ncunit: Function to get the dimensions of a given 2D variable inside a unit of a netCDF file
     28! get_var3dims_ncunit: Function to get the dimensions of a given 3D variable inside a unit of a netCDF file
     29! get_varNdims_file: Function to get the number of dimensions of a given variable inside a file
     30! get_varNdims_ncunit: Function to get the number of dimensions of a given variable inside a unit of a netCDF file
     31! get_varI1D_ncunit: Subroutine to get a 1D integer variable from a netCDF file unit
     32! get_varI2D_ncunit: Subroutine to get a 2D integer variable from a netCDF file unit
     33! get_varRK0D_ncunit: Subroutine to get an scalar r_k float variable from a netCDF file unit
     34! get_varRK1D_ncunit: Subroutine to get a 1D r_k float variable from a netCDF file unit
     35! get_varRK2D_ncunit: Subroutine to get a 2D r_k float variable from a netCDF file unit
     36! get_varRK3D_ncunit: Subroutine to get a 3D r_k float variable from a netCDF file unit
     37! get_varRK2D_ncunit: Subroutine to get a 4D r_k float variable from a netCDF file unit
     38! put_var1D: Subroutine to write on a netCDF file a 1D float variable
     39! put_var2D: Subroutine to write on a netCDF file a 2D float variable
     40! put_var3D: Subroutine to write on a netCDF file a 3D float variable
     41! put_var1Dt: Subroutine to write on a netCDF file a 1D float variable at a given time-step
     42! put_var2Dt: Subroutine to write on a netCDF file a 2D float variable at a given time-step
     43! put_var3Dt: Subroutine to write on a netCDF file a 3D float variable at a given time-step
    2144
    2245  USE module_definitions
     46  USE module_basic
    2347
    2448  CONTAINS
    … …  
    5579
    5680  END FUNCTION index_list_coordsI
    57 
    58   CHARACTER(len=1000) FUNCTION vectorR_KS(d1, vector)
    59   ! Function to transform a vector of reals(r_k) to a string of characters
    60 
    61     IMPLICIT NONE
    62 
    63     INTEGER, INTENT(in)                                  :: d1
    64     REAL(r_k), DIMENSION(d1), INTENT(in)                 :: vector
    65 
    66 ! Local
    67     INTEGER                                              :: iv
    68     CHARACTER(len=50)                                    :: RS
    69 
    70 !!!!!!! Variables
    71 ! d1: length of the vector
    72 ! vector: values to transform
    73 
    74     fname = 'vectorR_KS'
    75 
    76     vectorR_KS = ''
    77     DO iv=1, d1
    78       WRITE(RS, '(F50.25)')vector(iv)
    79       IF (iv == 1) THEN
    80         vectorR_KS = TRIM(RS)
    81       ELSE
    82         vectorR_KS = TRIM(vectorR_KS) // ', ' // TRIM(RS)
    83       END IF
    84     END DO   
    85 
    86   END FUNCTION vectorR_KS
    87 
    88 CHARACTER(len=1000) FUNCTION Nstrings(Strval, Ntimes)
    89 ! Function to repeat a number of times a given string
    90 
    91   IMPLICIT NONE
    92 
    93   CHARACTER(LEN=50), INTENT(in)                        :: Strval
    94   INTEGER, INTENT(in)                                  :: Ntimes
    95 
    96 ! Local
    97   INTEGER                                              :: i
    98 
    99 !!!!!!! Variables
    100 ! Strval: String to repeat
    101 ! Ntimes: number of repetitions
    102 
    103   fname = 'Nstrings'
    104 
    105   Nstrings = ''
    106   Do i=1, Ntimes
    107     Nstrings = TRIM(Nstrings) // TRIM(Strval)
    108   END DO
    109 
    110 END FUNCTION Nstrings
    11181
    11282  INTEGER FUNCTION Index1DArrayI(array1D, d1, val)
    … …  
    289259  END FUNCTION RangeR
    290260
    291 
    292261  FUNCTION RangeR_K(d1, iniv, endv)
    293262! Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector
    … …  
    314283  END FUNCTION RangeR_K
    315284
    316   SUBROUTINE split(String,charv,Nvalues,values)
    317 ! Subroutine which provides the values from a string [String] which has been split by a given
    318 !   character [charv] a given number of values [Nvalues] is expected
    319 
    320     IMPLICIT NONE
    321 
    322     CHARACTER(LEN=1000), INTENT(IN)                        :: String
    323     CHARACTER(LEN=1), INTENT(IN)                           :: charv
    324     INTEGER, INTENT(IN)                                    :: Nvalues
    325     CHARACTER(LEN=200), INTENT(OUT), DIMENSION(Nvalues)    :: values
    326 
    327 ! Local
    328     INTEGER                                                :: i, ibeg, iend, Lstring
    329     CHARACTER(LEN=3)                                       :: numS
    330     CHARACTER(LEN=1000)                                    :: newString
    331 
    332 !!!!!!! Variables
    333 ! String: String to split
    334 ! charv: Character to use
    335 ! Nvalues: number of values
    336 ! values: vector with the given values (up to 200 characters)
    337 
    338     fname = 'split'
    339 
    340     newString = String
    341     ibeg = 1
    342     Lstring = LEN_TRIM(String)
    343 
    344     DO i=1,Nvalues-1
    345       iend = INDEX(newString(ibeg:Lstring), charv)
    346 
    347       IF (iend == 0) THEN
    348         WRITE (numS,"(I3)")Nvalues - 1
    349         msg = "String '" // TRIM(String) // "' does not have " // TRIM(numS) // " '" // charv // "' !!"
    350         CALL ErrMsg(msg, fname, -1)
     285  INTEGER FUNCTION freeunit()
     286! provides the number of a free unit in which open a file
     287
     288    IMPLICIT NONE
     289
     290    INTEGER                                              :: funit
     291    LOGICAL                                              :: is_used
     292
     293    is_used = .true.
     294    DO freeunit=10,100
     295      INQUIRE(unit=funit, opened=is_used)
     296      IF (.not. is_used) EXIT
     297    END DO
     298
     299    RETURN
     300
     301  END FUNCTION freeunit
     302
     303  SUBROUTINE GetInNamelist(namelistfile, param, kindparam, Ival, Rval, Lval, Sval)
     304! Subroutine to get a paramter from a namelistfile
     305
     306    IMPLICIT NONE
     307
     308    CHARACTER(LEN=*), INTENT(IN)                         :: namelistfile, param
     309    CHARACTER(LEN=1), INTENT(IN)                         :: kindparam
     310    INTEGER, OPTIONAL, INTENT(OUT)                       :: Ival
     311    REAL, OPTIONAL, INTENT(OUT)                          :: Rval
     312    LOGICAL, OPTIONAL, INTENT(OUT)                       :: Lval
     313    CHARACTER(LEN=200), OPTIONAL, INTENT(OUT)            :: Sval
     314
     315! Local
     316    INTEGER                                              :: i, funit, ios
     317    INTEGER                                              :: Lparam, posparam
     318    LOGICAL                                              :: is_used
     319    CHARACTER(LEN=1000)                                  :: line, message
     320    CHARACTER(LEN=200), DIMENSION(2)                     :: lvals
     321    CHARACTER(LEN=200)                                   :: pval
     322
     323!!!!!!! Variables
     324! namelistfile: name of the namelist file
     325! param: parameter to get
     326! paramkind: kind of the parameter (I: Integer, L: boolean, R: Real, S: String)
     327
     328    fname = 'GetInNamelist'
     329
     330! Reading dimensions file and defining dimensions
     331    is_used = .true.
     332    DO funit=10,100
     333      INQUIRE(unit=funit, opened=is_used)
     334      IF (.not. is_used) EXIT
     335    END DO
     336
     337    OPEN(funit, FILE=TRIM(namelistfile), STATUS='old', FORM='formatted', IOSTAT=ios)
     338    IF ( ios /= 0 ) CALL stoprun(message, fname)
     339
     340    Lparam = LEN_TRIM(param)
     341 
     342    DO i=1,10000
     343      READ(funit,"(A200)",END=100)line
     344      posparam = INDEX(TRIM(line), TRIM(param))
     345      IF (posparam /= 0) EXIT
     346
     347    END DO
     348 100 CONTINUE
     349
     350    IF (posparam == 0) THEN
     351      message = "namelist '" // TRIM(namelistfile) // "' does not have parameter '" // TRIM(param) // &
     352        "' !!"
     353      CALL stoprun(message, fname)
     354    END IF
     355
     356    CLOSE(UNIT=funit)
     357
     358    CALL split(line, '=', 2, lvals)
     359    IF (kindparam /= 'S') THEN
     360      CALL RemoveNonNum(lvals(2), pval)
     361    END IF
     362
     363! L. Fita, LMD. October 2015
     364!   Up to now, only getting scalar values
     365    kparam: SELECT CASE (kindparam)
     366      CASE ('I')
     367        Ival = StoI(pval)
     368!        PRINT *,TRIM(param),'= ', Ival
     369      CASE ('L')
     370        Lval = StoL(pval)
     371!        PRINT *,TRIM(param),'= ', Lval
     372      CASE ('R')
     373        Rval = StoR(pval)
     374!        PRINT *,TRIM(param),'= ', Rval
     375      CASE ('S')
     376        Sval = lvals(2)
     377
     378      CASE DEFAULT
     379        message = "type of parameter '" // kindparam // "' not ready !!"
     380        CALL stoprun(message, fname)
     381
     382    END SELECT kparam
     383
     384  END SUBROUTINE GetInNamelist
     385
     386  SUBROUTINE stoprun(msg, fname)
     387! Subroutine to stop running and print a message
     388
     389    IMPLICIT NONE
     390
     391    CHARACTER(LEN=*), INTENT(IN)                           :: fname
     392    CHARACTER(LEN=*), INTENT(IN)                           :: msg
     393
     394! local
     395    CHARACTER(LEN=50)                                      :: errmsg, warnmsg
     396
     397    errmsg = 'ERROR -- error -- ERROR -- error'
     398
     399    PRINT *, TRIM(errmsg)
     400    PRINT *, '  ' // TRIM(fname) // ': ' // TRIM(msg)
     401    STOP -1
     402
     403  END SUBROUTINE stoprun
     404
     405!!!!!!! !!!!!! !!!!! !!!! !!! !! !
     406! Netcdf derived
     407
     408! From UNIDATA: https://www.unidata.ucar.edu/software/netcdf/docs/netcdf-f90.html
     409  SUBROUTINE handle_err(st)
     410! Subroutine to provide the error message when something with netCDF went wrong
     411
     412  USE netcdf
     413
     414  INTEGER, INTENT(IN)                                    :: st
     415
     416  IF (st /= nf90_noerr) THEN
     417    PRINT *, TRIM(emsg)
     418    PRINT *, TRIM(nf90_strerror(st))
     419    STOP "Stopped"
     420  END IF
     421
     422  END SUBROUTINE handle_err
     423
     424  SUBROUTINE create_NCfile(filename, dimsfile, namelistfile, varsfile, ncid)
     425! Subroutine to create a netCDF file
     426
     427    USE netcdf
     428
     429    IMPLICIT NONE
     430
     431    INCLUDE 'netcdf.inc'
     432
     433    CHARACTER(LEN=*), INTENT(IN)                         :: filename, dimsfile, namelistfile, varsfile
     434    INTEGER, INTENT(OUT)                                 :: ncid
     435
     436! Local
     437    INTEGER                                              :: i, j, k, idimnew
     438    INTEGER                                              :: rcode, funit, funit2, ios
     439    INTEGER                                              :: Nvals, dimsize, dimid, iddimnew, Ntotdims
     440    INTEGER                                              :: idvarnew, vartype
     441    CHARACTER(LEN=200)                                   :: message, vd, vs, vdd, val
     442    CHARACTER(LEN=200)                                   :: vname, Lvname, vunits, coornames
     443    CHARACTER(LEN=200), DIMENSION(:), ALLOCATABLE        :: valsline, dimsizes
     444    CHARACTER(LEN=1000)                                  :: line, dimsline
     445    INTEGER, DIMENSION(:), ALLOCATABLE                   :: dimsvar
     446    INTEGER                                              :: Ldimsize, Ldimsvar, dvarL
     447    CHARACTER(LEN=1)                                     :: dvarn
     448
     449!!!!!!! Variables
     450! filename: name of the file to create
     451! dimsfile: ASCII file with the name of the dimensions to create with ('#' for comentaries)
     452!   [dim name]| [dim orig in WRF]| [dim orig in namelist]| ['unlimited' also, 'namelist' (from namelist parameter)]
     453! namelistfile: name of the Namelist file
     454! varsfile: ASCII file with the name of the variables to create with ('#' for comentaries)
     455!   [WRFvarname]| [var name]| [long var name]| [var units]| [var dimensions]
     456! ncid: number assigned to the file
     457
     458    fname = 'create_NCfile'
     459
     460! Opening creation status
     461    rcode = nf90_create(TRIM(filename), NF90_NETCDF4, ncid)
     462    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     463
     464! Reading dimensions file
     465    funit = freeunit()
     466    OPEN(funit, FILE=TRIM(dimsfile), STATUS='old', FORM='formatted', IOSTAT=ios)
     467    message = "Problems to open varibales file '" // TRIM(varsfile) // "' IOSTAT = "//                &
     468      TRIM(ItoS(ios)) // " !!"
     469    IF ( ios /= 0 ) CALL stoprun(message, fname)
     470
     471    Nvals = 4
     472    IF (ALLOCATED(valsline)) DEALLOCATE(valsline)
     473    ALLOCATE (valsline(Nvals))
     474
     475! Creation of dimensions
     476    idimnew = 3
     477    dimsline = ''
     478    Ntotdims = 0
     479    DO i=1,1000
     480      READ(funit, '(A1000)', END=100)line
     481      IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
     482        CALL split(line,'|',Nvals,valsline)
     483        CALL removeChar(valsline(4),' ')
     484        IF (TRIM(valsline(4)) == 'unlimited') THEN
     485          idimnew = idimnew + 1
     486          dimsize = NF90_UNLIMITED
     487          dimid = idimnew
     488        ELSE IF (TRIM(valsline(4)) == 'namelist') THEN
     489          CALL GetInNamelist(namelistfile, valsline(3), 'I', Ival=dimsize)
     490          SELECT CASE (TRIM(valsline(2)))
     491            CASE ('i')
     492              dimid = 1
     493            CASE ('j')
     494              dimid = 2
     495            CASE ('k')
     496              dimid = 3
     497            CASE ('t')
     498              dimid = 4
     499              dimsize = NF90_UNLIMITED
     500            CASE DEFAULT
     501              idimnew = idimnew + 1
     502              dimid = idimnew
     503          END SELECT
     504        END IF
     505        rcode = nf90_def_dim(ncid, TRIM(valsline(1)), dimsize, dimid)
     506        IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     507        vs = valsline(2)
     508        CALL removeChar(vs, ' ')
     509        CALL attachString(dimsline, TRIM(vs) // ':' // TRIM(ItoS(dimid)) // ';')
     510        Ntotdims = Ntotdims + 1
    351511      END IF
    352 
    353       values(i) = newString(ibeg:ibeg+iend-2)
    354       ibeg = ibeg+iend
    355     END DO
    356     values(Nvalues) = newString(ibeg:Lstring)
    357 
    358   END SUBROUTINE split
    359 
    360 SUBROUTINE ErrMsg(msg, funcn, errN)
    361 ! Subroutine to stop execution and provide an error message
    362 
    363   IMPLICIT NONE
    364 
    365   CHARACTER(LEN=*), INTENT(in)                           :: msg, funcn
    366   INTEGER, INTENT(in)                                    :: errN
    367 
    368 ! Local
    369   CHARACTER(LEN=50)                                      :: emsg
    370 
    371 !!!!!!! Variables
    372 ! msg: message to print with the error
    373 ! funcn: name of the funciton, section to localize the error
    374 ! errN: number of the error provided for a given FORTRAN function
    375 
    376   emsg = 'ERORR -- error -- ERROR -- error'
    377 
    378   IF (errN /= 0) THEN
    379     PRINT *,TRiM(emsg)
    380     PRINT *,'  ' // TRIM(funcn) // ': ' // TRIM(msg) // ' !!'
    381     PRINT *,'    error number:', errN
    382     STOP
    383   END IF
    384 
    385   RETURN
    386 
    387 END SUBROUTINE ErrMsg
    388 
    389   CHARACTER(LEN=50) FUNCTION ErrWarnMsg(msg)
    390 ! Function to print error/warning message
    391 
    392     IMPLICIT NONE
    393 
    394     CHARACTER(LEN=3), INTENT(in)                         :: msg
    395 ! Local
    396 
    397     fname = 'ErrWarnMsg'
    398 
    399     IF (msg == 'err') THEN
    400       ErrWarnMsg = 'ERROR -- error -- ERROR -- error'
    401     ELSE IF (msg == 'wrn') THEN
    402       ErrWarnMsg = 'WARNING -- warning -- WARNING -- warning'
    403     ELSE
    404       PRINT *,'ERROR -- error -- ERROR -- error'
    405       PRINT *,'  ' // TRIM(fname) // ": '" // TRIM(msg) // "' does not exist!!"
    406       STOP
    407     END IF
    408   END FUNCTION ErrWarnMsg
     512    END DO
     513
     514 100 CONTINUE
     515    CLOSE(funit)
     516
     517! Sort of python dictionary for [dimn]:[dimsize]...
     518    IF (ALLOCATED(dimsizes)) DEALLOCATE(dimsizes)
     519    ALLOCATE(dimsizes(Ntotdims))
     520    CALL split(dimsline,';',Ntotdims,dimsizes)
     521
     522! Reading variables file
     523    funit = freeunit()
     524    OPEN(funit, FILE=TRIM(varsfile), STATUS='old', FORM='formatted', IOSTAT=ios)
     525   
     526    message = "Problems to open varibales file '" // TRIM(varsfile) // "' IOSTAT = "//                &
     527      TRIM(ItoS(ios)) // " !!"
     528    IF ( ios /= 0 ) CALL stoprun(message, fname)
     529
     530    Nvals = 6
     531    IF (ALLOCATED(valsline)) DEALLOCATE(valsline)
     532    ALLOCATE (valsline(Nvals))
     533
     534! Defining variables
     535    idvarnew = 1
     536    DO i=1,1000
     537      READ(funit, '(A1000)', END=150)line
     538      IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
     539        CALL split(line,'|',Nvals,valsline)
     540        vtype: SELECT CASE (TRIM(valsline(6)))
     541          CASE ('B')
     542            vartype = NF_BYTE
     543          CASE ('C')
     544            vartype = NF_CHAR
     545          CASE ('I')
     546            vartype = NF_SHORT
     547          CASE ('I16')
     548            vartype = NF_INT
     549          CASE ('R')
     550            vartype = NF_FLOAT
     551          CASE ('R16')
     552            vartype = NF_DOUBLE
     553        END SELECT vtype
     554
     555        vd = valsline(5)
     556        CALL removeChar(vd, ' ')
     557        Ldimsvar = LEN_TRIM(vd)
     558        IF (ALLOCATED(dimsvar)) DEALLOCATE(dimsvar)
     559        ALLOCATE(dimsvar(Ldimsvar))
     560
     561! Variable's dimensions
     562        coornames = ''
     563        DO j=1, Ldimsvar
     564          DO k=1, Ntotdims
     565            IF (dimsizes(k)(1:1) == vd(j:j)) THEN
     566              Ldimsize = LEN_TRIM(dimsizes(k))
     567              vdd = dimsizes(k)(3:Ldimsize)
     568              dimsvar(j) = StoI(vdd)
     569! Too complicated to assign dimvarname... (or too lazy)
     570!              coornames = coornames //
     571              CYCLE
     572            END IF
     573          END DO
     574        END DO
     575        vname = valsline(2)
     576        CALL removeChar(vname, ' ')
     577        vartype = 5
     578       
     579        rcode = nf90_def_var(ncid, vname, vartype, dimsvar, idvarnew)
     580        IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     581
     582! Adding attributes
     583        rcode = nf90_put_att(ncid, idvarnew, 'standard_name', TRIM(valsline(2)))
     584        IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     585        rcode = nf90_put_att(ncid, idvarnew, 'long_name', TRIM(valsline(3)))
     586        IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     587        rcode = nf90_put_att(ncid, idvarnew, 'units', TRIM(valsline(4)))
     588        IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     589
     590        idvarnew = idvarnew + 1
     591      END IF
     592    END DO
     593
     594 150 CONTINUE
     595    CLOSE(funit)
     596
     597    rcode = NF90_ENDDEF(ncid)
     598    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     599
     600    DEALLOCATE(valsline)
     601    DEALLOCATE(dimsizes)
     602
     603  END SUBROUTINE create_NCfile
     604
     605  FUNCTION get_var2dims_file(filename, varname)
     606! Function to get the dimensions of a given 2D variable inside a file
     607
     608    USE netcdf
     609
     610    IMPLICIT NONE
     611
     612    CHARACTER(LEN=*), INTENT(in)                         :: filename, varname
     613! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
     614    INTEGER, DIMENSION(2)                                :: get_var2dims_file
     615
     616! Local
     617    INTEGER                                              :: nid, vid, Ndims
     618    INTEGER                                              :: rcode
     619    INTEGER, DIMENSION(2)                                :: dimsid
     620
     621!!!!!!! Variables
     622! filename: name of the file to open
     623! varname: name of the variable
     624
     625    fname = 'get_var2dims_file'
     626    PRINT *,TRIM(fname)
     627
     628! Opening creation status
     629    rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
     630    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     631
     632    rcode = nf90_inq_varid(nid, varname, vid)
     633    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     634
     635    rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
     636    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     637
     638    IF (Ndims /= 2) THEN
     639      msg = "variable '" // TRIM(varname) // "' has not 2 dimensions!!"
     640      CALL stoprun(msg, fname)
     641    END IF
     642
     643    rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
     644    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     645
     646    rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var2dims_file(1))
     647    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     648
     649    rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var2dims_file(2))
     650    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     651
     652    rcode = NF90_CLOSE(nid)
     653    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     654
     655  END FUNCTION get_var2dims_file
     656
     657  FUNCTION get_var3dims_file(filename, varname)
     658! Function to get the dimensions of a given 3D variable inside a file
     659
     660    USE netcdf
     661
     662    IMPLICIT NONE
     663
     664    CHARACTER(LEN=*), INTENT(in)                         :: filename, varname
     665! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
     666    INTEGER, DIMENSION(3)                                :: get_var3dims_file
     667
     668! Local
     669    INTEGER                                              :: nid, vid, Ndims
     670    INTEGER                                              :: rcode
     671    INTEGER, DIMENSION(3)                                :: dimsid
     672    CHARACTER(LEN=250)                                   :: msg
     673
     674!!!!!!! Variables
     675! filename: name of the file to open
     676! varname: name of the variable
     677
     678    fname = 'get_var3dims_file'
     679    PRINT *,TRIM(fname)
     680
     681! Opening creation status
     682    rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
     683    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     684
     685    rcode = nf90_inq_varid(nid, varname, vid)
     686    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     687
     688    rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
     689    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     690
     691    IF (Ndims /= 3) THEN
     692      msg = "variable '" // TRIM(varname) // "' has not 3 dimensions!!"
     693      CALL stoprun(msg, fname)
     694    END IF
     695
     696    rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
     697    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     698
     699    rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var3dims_file(1))
     700    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     701
     702    rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var3dims_file(2))
     703    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     704
     705    rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var3dims_file(3))
     706    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     707
     708    rcode = NF90_CLOSE(nid)
     709    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     710
     711  END FUNCTION get_var3dims_file
     712
     713  FUNCTION get_var1dims_ncunit(nid, varname)
     714! Function to get the dimensions of a given 1D variable inside a unit of a netCDF file
     715
     716    USE netcdf
     717
     718    IMPLICIT NONE
     719
     720    INTEGER, INTENT(in)                                  :: nid
     721    CHARACTER(LEN=*), INTENT(in)                         :: varname
     722! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
     723    INTEGER, DIMENSION(1)                                :: get_var1dims_ncunit
     724
     725! Local
     726    INTEGER                                              :: vid, Ndims
     727    INTEGER                                              :: rcode
     728    INTEGER, DIMENSION(1)                                :: dimsid
     729    CHARACTER(LEN=250)                                   :: msg
     730
     731!!!!!!! Variables
     732! filename: name of the file to open
     733! varname: name of the variable
     734
     735    fname = 'get_var1dims_ncunit'
     736    PRINT *,TRIM(fname)
     737
     738    rcode = nf90_inq_varid(nid, varname, vid)
     739    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     740
     741    rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
     742    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     743
     744    IF (Ndims /= 1) THEN
     745      msg = "variable '" // TRIM(varname) // "' has not 1 dimensions!!"
     746      CALL stoprun(msg, fname)
     747    END IF
     748
     749    rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
     750    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     751
     752    rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var1dims_ncunit(1))
     753    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     754
     755  END FUNCTION get_var1dims_ncunit
     756
     757  FUNCTION get_var2dims_ncunit(nid, varname)
     758! Function to get the dimensions of a given 2D variable inside a unit of a netCDF file
     759
     760    USE netcdf
     761
     762    IMPLICIT NONE
     763
     764    INTEGER, INTENT(in)                                  :: nid
     765    CHARACTER(LEN=*), INTENT(in)                         :: varname
     766! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
     767    INTEGER, DIMENSION(2)                                :: get_var2dims_ncunit
     768
     769! Local
     770    INTEGER                                              :: vid, Ndims
     771    INTEGER                                              :: rcode
     772    INTEGER, DIMENSION(2)                                :: dimsid
     773    CHARACTER(LEN=250)                                   :: msg
     774
     775!!!!!!! Variables
     776! filename: name of the file to open
     777! varname: name of the variable
     778
     779    fname = 'get_var2dims_ncunit'
     780    PRINT *,TRIM(fname)
     781
     782    rcode = nf90_inq_varid(nid, varname, vid)
     783    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     784
     785    rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
     786    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     787
     788    IF (Ndims /= 2) THEN
     789      msg = "variable '" // TRIM(varname) // "' has not 2 dimensions!!"
     790      CALL stoprun(msg, fname)
     791    END IF
     792
     793    rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
     794    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     795
     796    rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var2dims_ncunit(1))
     797    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     798
     799    rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var2dims_ncunit(2))
     800    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     801
     802  END FUNCTION get_var2dims_ncunit
     803
     804  FUNCTION get_var3dims_ncunit(nid, varname)
     805! Function to get the dimensions of a given 3D variable inside a unit of a netCDF file
     806
     807    USE netcdf
     808
     809    IMPLICIT NONE
     810
     811    INTEGER, INTENT(in)                                  :: nid
     812    CHARACTER(LEN=*), INTENT(in)                         :: varname
     813! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
     814    INTEGER, DIMENSION(3)                                :: get_var3dims_ncunit
     815
     816! Local
     817    INTEGER                                              :: vid, Ndims
     818    INTEGER                                              :: rcode
     819    INTEGER, DIMENSION(3)                                :: dimsid
     820    CHARACTER(LEN=250)                                   :: msg
     821
     822!!!!!!! Variables
     823! filename: name of the file to open
     824! varname: name of the variable
     825
     826    fname = 'get_var3dims_ncunit'
     827    PRINT *,TRIM(fname)
     828
     829    rcode = nf90_inq_varid(nid, varname, vid)
     830    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     831
     832    rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
     833    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     834
     835    IF (Ndims /= 3) THEN
     836      msg = "variable '" // TRIM(varname) // "' has not 3 dimensions!!"
     837      CALL stoprun(msg, fname)
     838    END IF
     839
     840    rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
     841    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     842
     843    rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var3dims_ncunit(1))
     844    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     845
     846    rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var3dims_ncunit(2))
     847    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     848
     849    rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var3dims_ncunit(3))
     850    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     851
     852  END FUNCTION get_var3dims_ncunit
     853
     854  FUNCTION get_var4dims_file(filename, varname)
     855! Function to get the dimensions of a given 4D variable inside a file
     856
     857    USE netcdf
     858
     859    IMPLICIT NONE
     860
     861    CHARACTER(LEN=*), INTENT(in)                         :: filename, varname
     862! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
     863    INTEGER, DIMENSION(4)                                :: get_var4dims_file
     864
     865! Local
     866    INTEGER                                              :: nid, vid, Ndims
     867    INTEGER                                              :: rcode
     868    INTEGER, DIMENSION(4)                                :: dimsid
     869    CHARACTER(LEN=250)                                   :: msg
     870
     871!!!!!!! Variables
     872! filename: name of the file to open
     873! varname: name of the variable
     874
     875    fname = 'get_var4dims_file'
     876    PRINT *,TRIM(fname)
     877
     878! Opening creation status
     879    rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
     880    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     881
     882    rcode = nf90_inq_varid(nid, varname, vid)
     883    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     884
     885    rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
     886    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     887
     888    IF (Ndims /= 4) THEN
     889      msg = "variable '" // TRIM(varname) // "' has not 4 dimensions!!"
     890      CALL stoprun(msg, fname)
     891    END IF
     892
     893    rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
     894    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     895
     896    rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var4dims_file(1))
     897    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     898
     899    rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var4dims_file(2))
     900    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     901
     902    rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var4dims_file(3))
     903    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     904
     905    rcode = nf90_inquire_dimension(nid, dimsid(4), LEN = get_var4dims_file(4))
     906    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     907
     908    rcode = NF90_CLOSE(nid)
     909    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     910
     911  END FUNCTION get_var4dims_file
     912
     913  INTEGER FUNCTION get_varNdims_file(filename, varname)
     914! Function to get the number of dimensions of a given variable inside a file
     915
     916    USE netcdf
     917
     918    IMPLICIT NONE
     919
     920    CHARACTER(LEN=*), INTENT(in)                         :: filename, varname
     921
     922! Local
     923    INTEGER                                              :: nid, vid
     924    INTEGER                                              :: rcode
     925
     926!!!!!!! Variables
     927! filename: name of the file to open
     928! varname: name of the variable
     929
     930    fname = 'get_varNdims_file'
     931    PRINT *,TRIM(fname)
     932
     933! Opening creation status
     934    rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
     935    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     936
     937    rcode = nf90_inq_varid(nid, varname, vid)
     938    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     939
     940    rcode = nf90_inquire_variable(nid, vid, NDIMS = get_varNdims_file)
     941    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     942
     943    rcode = NF90_CLOSE(nid)
     944    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     945
     946  END FUNCTION get_varNdims_file
     947
     948  INTEGER FUNCTION get_varNdims_ncunit(nid, varname)
     949! Function to get the number of dimensions of a given variable inside a unit of a netCDF file
     950
     951    USE netcdf
     952
     953    IMPLICIT NONE
     954
     955    INTEGER, INTENT(in)                                  :: nid
     956    CHARACTER(LEN=*), INTENT(in)                         :: varname
     957
     958! Local
     959    INTEGER                                              :: vid
     960    INTEGER                                              :: rcode
     961
     962!!!!!!! Variables
     963! filename: name of the file to open
     964! varname: name of the variable
     965
     966    fname = 'get_varNdims_ncunit'
     967    PRINT *,TRIM(fname)
     968
     969    rcode = nf90_inq_varid(nid, varname, vid)
     970    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     971
     972    rcode = nf90_inquire_variable(nid, vid, NDIMS = get_varNdims_ncunit)
     973    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     974
     975  END FUNCTION get_varNdims_ncunit
     976
     977LOGICAL FUNCTION isin_file(filename, varname)
     978! Function to tell if a given variable is inside a file
     979
     980    USE netcdf
     981
     982    IMPLICIT NONE
     983
     984    CHARACTER(LEN=*), INTENT(in)                         :: filename, varname
     985
     986! Local
     987    INTEGER                                              :: nid, vid, Ndims, Nvars
     988    INTEGER                                              :: iv, rcode
     989    CHARACTER(LEN=1000)                                  :: varinfile
     990    CHARACTER(LEN=250)                                   :: msg
     991
     992!!!!!!! Variables
     993! filename: name of the file to open
     994! varname: name of the variable
     995
     996    fname = 'isin_file'
     997
     998! Opening creation status
     999    rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
     1000    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1001
     1002    rcode = nf90_inquire(nid, Ndims, Nvars)
     1003    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1004
     1005    DO iv=1, Nvars
     1006      rcode = nf90_inquire_variable(nid, iv, name=varinfile)
     1007      IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1008      IF (TRIM(varinfile) == TRIM(varname)) THEN
     1009        isin_file = .TRUE.
     1010        EXIT
     1011      ELSE
     1012        isin_file = .FALSE.
     1013      END IF
     1014    END DO
     1015
     1016    rcode = NF90_CLOSE(nid)
     1017    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1018   
     1019  END FUNCTION isin_file
     1020
     1021LOGICAL FUNCTION isin_ncunit(nid, varname)
     1022! Function to tell if a given variable is inside a netcdf file unit
     1023
     1024    USE netcdf
     1025
     1026    IMPLICIT NONE
     1027
     1028    INTEGER, INTENT(in)                                  :: nid
     1029    CHARACTER(LEN=*), INTENT(in)                         :: varname
     1030
     1031! Local
     1032    INTEGER                                              :: vid, Ndims, Nvars
     1033    INTEGER                                              :: iv, rcode
     1034    CHARACTER(LEN=1000)                                  :: varinfile
     1035    CHARACTER(LEN=250)                                   :: msg
     1036
     1037!!!!!!! Variables
     1038! nid: number of the opened netCDF
     1039! varname: name of the variable
     1040
     1041    fname = 'isin_ncunit'
     1042
     1043    rcode = nf90_inquire(nid, Ndims, Nvars)
     1044    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1045
     1046    DO iv=1, Nvars
     1047      rcode = nf90_inquire_variable(nid, iv, name=varinfile)
     1048      IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1049      IF (TRIM(varinfile) == TRIM(varname)) THEN
     1050        isin_ncunit = .TRUE.
     1051        EXIT
     1052      ELSE
     1053        isin_ncunit = .FALSE.
     1054      END IF
     1055    END DO
     1056   
     1057  END FUNCTION isin_ncunit
     1058
     1059  SUBROUTINE put_var1D(ncid, d1, vals, vname, filevarn)
     1060! Subroutine to write on a netCDF file a 1D float variable
     1061
     1062    USE netcdf
     1063
     1064    IMPLICIT NONE
     1065
     1066    INTEGER, INTENT(IN)                                  :: ncid, d1
     1067    REAL, DIMENSION(d1), INTENT(IN)                      :: vals
     1068    CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
     1069 
     1070! Local
     1071    INTEGER                                              :: funit, i, idvarnew, ios
     1072    INTEGER                                              :: Nvals, rcode, varid
     1073    CHARACTER(LEN=50)                                    :: ncvarname
     1074    CHARACTER(LEN=1000)                                  :: line
     1075    CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
     1076    LOGICAL                                              :: vfound
     1077
     1078!!!!!!! Variables
     1079! ncid: netCDF file identifier
     1080! d1: shape of the matrix
     1081! vals: values to include
     1082! vname: name of the variable in the model to be included
     1083! filevarn: name of the ASCII file with the information about the variables
     1084    fname = 'put_var1D'
     1085
     1086! Reading variables file
     1087    funit = freeunit()
     1088    OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
     1089    msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
     1090      TRIM(ItoS(ios)) // " !!"
     1091    IF ( ios /= 0 ) CALL stoprun(msg, fname)
     1092
     1093    Nvals = 6
     1094
     1095    idvarnew = 1
     1096    vfound = .FALSE.
     1097    DO i=1,1000
     1098      READ(funit, '(A1000)', END=150)line
     1099      IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
     1100        CALL split(line,'|',Nvals,valsline)
     1101        IF (TRIM(vname) == TRIM(valsline(1))) THEN
     1102          ncvarname = TRIM(valsline(2))
     1103          CALL removeChar(ncvarname, ' ')
     1104          rcode = nf90_inq_varid(ncid, ncvarname, varid)
     1105          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1106
     1107          rcode = nf90_put_var(ncid, varid, vals)         
     1108          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1109          vfound = .TRUE.
     1110          CYCLE
     1111        END IF
     1112      END IF
     1113    END DO
     1114
     1115 150 CONTINUE
     1116
     1117    CLOSE(funit)
     1118    IF (.NOT.vfound) THEN
     1119      msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
     1120        "' !!"
     1121      CALL stoprun(msg, fname)
     1122    END IF
     1123
     1124  END SUBROUTINE put_var1D
     1125
     1126  SUBROUTINE put_var2D(ncid, d1, d2, vals, vname, filevarn)
     1127! Subroutine to write on a netCDF file a 2D float variable
     1128
     1129    USE netcdf
     1130
     1131    IMPLICIT NONE
     1132
     1133    INTEGER, INTENT(IN)                                  :: ncid, d1, d2
     1134    REAL, DIMENSION(d1,d2), INTENT(IN)                   :: vals
     1135    CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
     1136 
     1137! Local
     1138    INTEGER                                              :: funit, i, idvarnew, ios
     1139    INTEGER                                              :: Nvals, rcode, varid
     1140    CHARACTER(LEN=50)                                    :: ncvarname
     1141    CHARACTER(LEN=1000)                                  :: line
     1142    CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
     1143    LOGICAL                                              :: vfound
     1144
     1145!!!!!!! Variables
     1146! ncid: netCDF file identifier
     1147! d1,d2: shape of the matrix
     1148! vals: values to include
     1149! vname: name of the variable in the model to be included
     1150! filevarn: name of the ASCII file with the information about the variables
     1151    fname = 'put_var2D'
     1152
     1153! Reading variables file
     1154    funit = freeunit()
     1155    OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
     1156    msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
     1157      TRIM(ItoS(ios)) // " !!"
     1158    IF ( ios /= 0 ) CALL stoprun(msg, fname)
     1159
     1160    Nvals = 6
     1161
     1162    idvarnew = 1
     1163    vfound = .FALSE.
     1164    DO i=1,1000
     1165      READ(funit, '(A1000)', END=150)line
     1166      IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
     1167        CALL split(line,'|',Nvals,valsline)
     1168        IF (TRIM(vname) == TRIM(valsline(1))) THEN
     1169          ncvarname = TRIM(valsline(2))
     1170          CALL removeChar(ncvarname, ' ')
     1171          rcode = nf90_inq_varid(ncid, ncvarname, varid)
     1172          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1173
     1174          rcode = nf90_put_var(ncid, varid, vals)         
     1175          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1176          vfound = .TRUE.
     1177          CYCLE
     1178        END IF
     1179      END IF
     1180    END DO
     1181
     1182 150 CONTINUE
     1183
     1184    CLOSE(funit)
     1185    IF (.NOT.vfound) THEN
     1186      msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
     1187        "' !!"
     1188      CALL stoprun(msg, fname)
     1189    END IF
     1190
     1191  END SUBROUTINE put_var2D
     1192
     1193  SUBROUTINE put_var3D(ncid, d1, d2, d3, vals, vname, filevarn)
     1194! Subroutine to write on a netCDF file a 3D float variable
     1195
     1196    USE netcdf
     1197
     1198    IMPLICIT NONE
     1199
     1200    INTEGER, INTENT(IN)                                  :: ncid, d1, d2, d3
     1201    REAL, DIMENSION(d1,d2,d3), INTENT(IN)                :: vals
     1202    CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
     1203 
     1204! Local
     1205    INTEGER                                              :: funit, i, idvarnew, ios
     1206    INTEGER                                              :: Nvals, rcode, varid
     1207    CHARACTER(LEN=50)                                    :: ncvarname
     1208    CHARACTER(LEN=1000)                                  :: line
     1209    CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
     1210    LOGICAL                                              :: vfound
     1211
     1212!!!!!!! Variables
     1213! ncid: netCDF file identifier
     1214! d1,d2,d3: shape of the matrix
     1215! vals: values to include
     1216! vname: name of the variable in the model to be included
     1217! filevarn: name of the ASCII file with the information about the variables
     1218    fname = 'put_var3D'
     1219
     1220! Reading variables file
     1221    funit = freeunit()
     1222    OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
     1223    msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
     1224      TRIM(ItoS(ios)) // " !!"
     1225    IF ( ios /= 0 ) CALL stoprun(msg, fname)
     1226
     1227    Nvals = 6
     1228
     1229    idvarnew = 1
     1230    vfound = .FALSE.
     1231    DO i=1,1000
     1232      READ(funit, '(A1000)', END=150)line
     1233      IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
     1234        CALL split(line,'|',Nvals,valsline)
     1235        IF (TRIM(vname) == TRIM(valsline(1))) THEN
     1236          ncvarname = TRIM(valsline(2))
     1237          CALL removeChar(ncvarname, ' ')
     1238          rcode = nf90_inq_varid(ncid, ncvarname, varid)
     1239          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1240
     1241          rcode = nf90_put_var(ncid, varid, vals)         
     1242          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1243          vfound = .TRUE.
     1244          CYCLE
     1245        END IF
     1246      END IF
     1247    END DO
     1248
     1249 150 CONTINUE
     1250    CLOSE(funit)
     1251
     1252    IF (.NOT.vfound) THEN
     1253      msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
     1254        "' !!"
     1255      CALL stoprun(msg, fname)
     1256    END IF
     1257
     1258  END SUBROUTINE put_var3D
     1259
     1260  SUBROUTINE put_var1Dt(ncid, d1, vals, vname, filevarn, it)
     1261! Subroutine to write on a netCDF file a 1D float variable at a given time-step
     1262
     1263    USE netcdf
     1264
     1265    IMPLICIT NONE
     1266
     1267    INTEGER, INTENT(IN)                                  :: ncid, d1, it
     1268    REAL, DIMENSION(d1), INTENT(IN)                      :: vals
     1269    CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
     1270 
     1271! Local
     1272    INTEGER                                              :: funit, i, idvarnew, ios
     1273    INTEGER                                              :: Nvals, rcode, varid
     1274    CHARACTER(LEN=50)                                    :: ncvarname
     1275    CHARACTER(LEN=1000)                                  :: line
     1276    CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
     1277    LOGICAL                                              :: vfound
     1278
     1279!!!!!!! Variables
     1280! ncid: netCDF file identifier
     1281! d1: shape of the matrix
     1282! vals: values to include
     1283! vname: name of the variable in the model to be included
     1284! filevarn: name of the ASCII file with the information about the variables
     1285! it: time-step to add
     1286
     1287    fname = 'put_var1Dt'
     1288
     1289! Reading variables file
     1290    funit = freeunit()
     1291    OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
     1292    msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
     1293      TRIM(ItoS(ios)) // " !!"
     1294    IF ( ios /= 0 ) CALL stoprun(msg, fname)
     1295
     1296    Nvals = 6
     1297
     1298    idvarnew = 1
     1299    vfound = .FALSE.
     1300    DO i=1,1000
     1301      READ(funit, '(A1000)', END=150)line
     1302      IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
     1303        CALL split(line,'|',Nvals,valsline)
     1304        IF (TRIM(vname) == TRIM(valsline(1))) THEN
     1305          ncvarname = TRIM(valsline(2))
     1306          CALL removeChar(ncvarname, ' ')
     1307          rcode = nf90_inq_varid(ncid, ncvarname, varid)
     1308          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1309
     1310          rcode = nf90_put_var(ncid, varid, vals, start=(/1,it/), count=(/d1,1/))
     1311          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1312          vfound = .TRUE.
     1313          CYCLE
     1314        END IF
     1315      END IF
     1316    END DO
     1317
     1318 150 CONTINUE
     1319
     1320    CLOSE(funit)
     1321    IF (.NOT.vfound) THEN
     1322      msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
     1323        "' !!"
     1324      CALL stoprun(msg, fname)
     1325    END IF
     1326
     1327  END SUBROUTINE put_var1Dt
     1328
     1329  SUBROUTINE put_var2Dt(ncid, d1, d2, vals, vname, filevarn, it)
     1330! Subroutine to write on a netCDF file a 2D float variable at a given time-step
     1331
     1332    USE netcdf
     1333
     1334    IMPLICIT NONE
     1335
     1336    INTEGER, INTENT(IN)                                  :: ncid, d1, d2, it
     1337    REAL, DIMENSION(d1), INTENT(IN)                      :: vals
     1338    CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
     1339 
     1340! Local
     1341    INTEGER                                              :: funit, i, idvarnew, ios
     1342    INTEGER                                              :: Nvals, rcode, varid
     1343    CHARACTER(LEN=50)                                    :: ncvarname
     1344    CHARACTER(LEN=1000)                                  :: line
     1345    CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
     1346    LOGICAL                                              :: vfound
     1347
     1348!!!!!!! Variables
     1349! ncid: netCDF file identifier
     1350! d1: shape of the matrix
     1351! vals: values to include
     1352! vname: name of the variable in the model to be included
     1353! filevarn: name of the ASCII file with the information about the variables
     1354! it: time-step to add
     1355
     1356    fname = 'put_var2Dt'
     1357
     1358! Reading variables file
     1359    funit = freeunit()
     1360    OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
     1361    msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
     1362      TRIM(ItoS(ios)) // " !!"
     1363    IF ( ios /= 0 ) CALL stoprun(msg, fname)
     1364
     1365    Nvals = 6
     1366
     1367    idvarnew = 1
     1368    vfound = .FALSE.
     1369    DO i=1,1000
     1370      READ(funit, '(A1000)', END=150)line
     1371      IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
     1372        CALL split(line,'|',Nvals,valsline)
     1373        IF (TRIM(vname) == TRIM(valsline(1))) THEN
     1374          ncvarname = TRIM(valsline(2))
     1375          CALL removeChar(ncvarname, ' ')
     1376          rcode = nf90_inq_varid(ncid, ncvarname, varid)
     1377          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1378
     1379          rcode = nf90_put_var(ncid, varid, vals, start=(/1,1,it/), count=(/d1,d2,1/))
     1380          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1381          vfound = .TRUE.
     1382          CYCLE
     1383        END IF
     1384      END IF
     1385    END DO
     1386
     1387 150 CONTINUE
     1388
     1389    CLOSE(funit)
     1390    IF (.NOT.vfound) THEN
     1391      msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
     1392        "' !!"
     1393      CALL stoprun(msg, fname)
     1394    END IF
     1395
     1396  END SUBROUTINE put_var2Dt
     1397
     1398  SUBROUTINE put_var3Dt(ncid, d1, d2, d3, vals, vname, filevarn, it)
     1399! Subroutine to write on a netCDF file a 3D float variable at a given time-step
     1400
     1401    USE netcdf
     1402
     1403    IMPLICIT NONE
     1404
     1405    INTEGER, INTENT(IN)                                  :: ncid, d1, d2, d3, it
     1406    REAL, DIMENSION(d1), INTENT(IN)                      :: vals
     1407    CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
     1408 
     1409! Local
     1410    INTEGER                                              :: funit, i, idvarnew, ios
     1411    INTEGER                                              :: Nvals, rcode, varid
     1412    CHARACTER(LEN=50)                                    :: ncvarname
     1413    CHARACTER(LEN=1000)                                  :: line
     1414    CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
     1415    LOGICAL                                              :: vfound
     1416
     1417!!!!!!! Variables
     1418! ncid: netCDF file identifier
     1419! d1,d2,d3: shape of the matrix
     1420! vals: values to include
     1421! vname: name of the variable in the model to be included
     1422! filevarn: name of the ASCII file with the information about the variables
     1423! it: time-step to add
     1424
     1425    fname = 'put_var3Dt'
     1426
     1427! Reading variables file
     1428    funit = freeunit()
     1429    OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
     1430    msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
     1431      TRIM(ItoS(ios)) // " !!"
     1432    IF ( ios /= 0 ) CALL stoprun(msg, fname)
     1433
     1434    Nvals = 6
     1435
     1436    idvarnew = 1
     1437    vfound = .FALSE.
     1438    DO i=1,1000
     1439      READ(funit, '(A1000)', END=150)line
     1440      IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
     1441        CALL split(line,'|',Nvals,valsline)
     1442        IF (TRIM(vname) == TRIM(valsline(1))) THEN
     1443          ncvarname = TRIM(valsline(2))
     1444          CALL removeChar(ncvarname, ' ')
     1445          rcode = nf90_inq_varid(ncid, ncvarname, varid)
     1446          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1447
     1448          rcode = nf90_put_var(ncid, varid, vals, start=(/1,1,1,it/), count=(/d1,d2,d3,1/))
     1449          IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1450          vfound = .TRUE.
     1451          CYCLE
     1452        END IF
     1453      END IF
     1454    END DO
     1455
     1456 150 CONTINUE
     1457
     1458    CLOSE(funit)
     1459    IF (.NOT.vfound) THEN
     1460      msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
     1461        "' !!"
     1462      CALL stoprun(msg, fname)
     1463    END IF
     1464
     1465  END SUBROUTINE put_var3Dt
     1466
     1467  SUBROUTINE get_varI1D_ncunit(ncid, d1, vname, vals)
     1468! Subroutine to get a 1D integer variable from a netCDF file unit
     1469
     1470    USE netcdf
     1471
     1472    IMPLICIT NONE
     1473
     1474    INTEGER, INTENT(in)                                  :: ncid, d1
     1475    CHARACTER(LEN=*), INTENT(in)                         :: vname
     1476    INTEGER, DIMENSION(d1), INTENT(out)                  :: vals
     1477 
     1478! Local
     1479    INTEGER                                              :: rcode, varid
     1480    LOGICAL                                              :: vfound
     1481
     1482!!!!!!! Variables
     1483! ncid: netCDF file identifier
     1484! d1: shape of the matrix
     1485! vals: values to get
     1486! vname: name of the variable to get
     1487
     1488    fname = 'get_varI1D_ncunit'
     1489
     1490    vfound = isin_ncunit(ncid, vname)
     1491
     1492    IF (.NOT.vfound) THEN
     1493      msg = "Unit file does not have variable '" // TRIM(vname) // "'"
     1494      CALL ErrMsg(msg, fname, -1)
     1495    END IF
     1496
     1497    rcode = nf90_inq_varid(ncid, vname, varid)
     1498    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1499
     1500    rcode = nf90_get_var(ncid, varid, vals)         
     1501    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1502
     1503  END SUBROUTINE get_varI1D_ncunit
     1504
     1505
     1506  SUBROUTINE get_varI2D_ncunit(ncid, d1, d2, vname, vals)
     1507! Subroutine to get a 2D integer variable from a netCDF file unit
     1508
     1509    USE netcdf
     1510
     1511    IMPLICIT NONE
     1512
     1513    INTEGER, INTENT(in)                                  :: ncid, d1, d2
     1514    CHARACTER(LEN=*), INTENT(in)                         :: vname
     1515    INTEGER, DIMENSION(d1,d2), INTENT(out)               :: vals
     1516 
     1517! Local
     1518    INTEGER                                              :: rcode, varid
     1519    LOGICAL                                              :: vfound
     1520
     1521!!!!!!! Variables
     1522! ncid: netCDF file identifier
     1523! d1: shape of the matrix
     1524! vals: values to get
     1525! vname: name of the variable to get
     1526
     1527    fname = 'get_varI2D_ncunit'
     1528
     1529    vfound = isin_ncunit(ncid, vname)
     1530
     1531    IF (.NOT.vfound) THEN
     1532      msg = "Unit file does not have variable '" // TRIM(vname) // "'"
     1533      CALL ErrMsg(msg, fname, -1)
     1534    END IF
     1535
     1536    rcode = nf90_inq_varid(ncid, vname, varid)
     1537    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1538
     1539    rcode = nf90_get_var(ncid, varid, vals)         
     1540    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1541
     1542  END SUBROUTINE get_varI2D_ncunit
     1543
     1544  SUBROUTINE get_varRK0D_ncunit(ncid, vname, vals)
     1545! Subroutine to get an scalar r_k float variable from a netCDF file unit
     1546
     1547    USE netcdf
     1548
     1549    IMPLICIT NONE
     1550
     1551    INTEGER, INTENT(in)                                  :: ncid
     1552    CHARACTER(LEN=*), INTENT(in)                         :: vname
     1553    REAL, INTENT(out)                                    :: vals
     1554 
     1555! Local
     1556    INTEGER                                              :: rcode, varid
     1557    LOGICAL                                              :: vfound
     1558
     1559!!!!!!! Variables
     1560! ncid: netCDF file identifier
     1561! vals: values to get
     1562! vname: name of the variable to get
     1563
     1564    fname = 'get_varRK0D_ncunit'
     1565
     1566    vfound = isin_ncunit(ncid, vname)
     1567
     1568    IF (.NOT.vfound) THEN
     1569      msg = "Unit file does not have variable '" // TRIM(vname) // "'"
     1570      CALL ErrMsg(msg, fname, -1)
     1571    END IF
     1572
     1573    rcode = nf90_inq_varid(ncid, vname, varid)
     1574    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1575
     1576    rcode = nf90_get_var(ncid, varid, vals)         
     1577    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1578
     1579  END SUBROUTINE get_varRK0D_ncunit
     1580
     1581  SUBROUTINE get_varRK1D_ncunit(ncid, d1, vname, vals)
     1582! Subroutine to get a 1D r_k float variable from a netCDF file unit
     1583
     1584    USE netcdf
     1585
     1586    IMPLICIT NONE
     1587
     1588    INTEGER, INTENT(in)                                  :: ncid, d1
     1589    CHARACTER(LEN=*), INTENT(in)                         :: vname
     1590    REAL, DIMENSION(d1), INTENT(out)                     :: vals
     1591 
     1592! Local
     1593    INTEGER                                              :: rcode, varid
     1594    LOGICAL                                              :: vfound
     1595
     1596!!!!!!! Variables
     1597! ncid: netCDF file identifier
     1598! d1: shape of the matrix
     1599! vals: values to get
     1600! vname: name of the variable to get
     1601
     1602    fname = 'get_varRK1D_ncunit'
     1603
     1604    vfound = isin_ncunit(ncid, vname)
     1605
     1606    IF (.NOT.vfound) THEN
     1607      msg = "Unit file does not have variable '" // TRIM(vname) // "'"
     1608      CALL ErrMsg(msg, fname, -1)
     1609    END IF
     1610
     1611    rcode = nf90_inq_varid(ncid, vname, varid)
     1612    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1613
     1614    rcode = nf90_get_var(ncid, varid, vals)         
     1615    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1616
     1617  END SUBROUTINE get_varRK1D_ncunit
     1618
     1619  SUBROUTINE get_varRK2D_ncunit(ncid, d1, d2, vname, vals)
     1620! Subroutine to get a 2D r_k float variable from a netCDF file unit
     1621
     1622    USE netcdf
     1623
     1624    IMPLICIT NONE
     1625
     1626    INTEGER, INTENT(in)                                  :: ncid, d1, d2
     1627    CHARACTER(LEN=*), INTENT(in)                         :: vname
     1628    REAL, DIMENSION(d1,d2), INTENT(out)                  :: vals
     1629 
     1630! Local
     1631    INTEGER                                              :: rcode, varid
     1632    LOGICAL                                              :: vfound
     1633
     1634!!!!!!! Variables
     1635! ncid: netCDF file identifier
     1636! d1,d2: shape of the matrix
     1637! vals: values to get
     1638! vname: name of the variable to get
     1639
     1640    fname = 'get_varRK2D_ncunit'
     1641
     1642    vfound = isin_ncunit(ncid, vname)
     1643
     1644    IF (.NOT.vfound) THEN
     1645      msg = "Unit file does not have variable '" // TRIM(vname) // "'"
     1646      CALL ErrMsg(msg, fname, -1)
     1647    END IF
     1648
     1649    rcode = nf90_inq_varid(ncid, vname, varid)
     1650    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1651
     1652    rcode = nf90_get_var(ncid, varid, vals)         
     1653    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1654
     1655  END SUBROUTINE get_varRK2D_ncunit
     1656
     1657  SUBROUTINE get_varRK3D_ncunit(ncid, d1, d2, d3, vname, vals)
     1658! Subroutine to get a 3D r_k float variable from a netCDF file unit
     1659
     1660    USE netcdf
     1661
     1662    IMPLICIT NONE
     1663
     1664    INTEGER, INTENT(in)                                  :: ncid, d1, d2, d3
     1665    CHARACTER(LEN=*), INTENT(in)                         :: vname
     1666    REAL, DIMENSION(d1,d2,d3), INTENT(out)               :: vals
     1667 
     1668! Local
     1669    INTEGER                                              :: rcode, varid
     1670    LOGICAL                                              :: vfound
     1671
     1672!!!!!!! Variables
     1673! ncid: netCDF file identifier
     1674! d1,d2,d3: shape of the matrix
     1675! vals: values to get
     1676! vname: name of the variable to get
     1677
     1678    fname = 'get_varRK3D_ncunit'
     1679
     1680    vfound = isin_ncunit(ncid, vname)
     1681
     1682    IF (.NOT.vfound) THEN
     1683      msg = "Unit file does not have variable '" // TRIM(vname) // "'"
     1684      CALL ErrMsg(msg, fname, -1)
     1685    END IF
     1686
     1687    rcode = nf90_inq_varid(ncid, vname, varid)
     1688    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1689
     1690    rcode = nf90_get_var(ncid, varid, vals)         
     1691    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1692
     1693  END SUBROUTINE get_varRK3D_ncunit
     1694
     1695  SUBROUTINE get_varRK4D_ncunit(ncid, d1, d2, d3, d4, vname, vals)
     1696! Subroutine to get a 4D r_k float variable from a netCDF file unit
     1697
     1698    USE netcdf
     1699
     1700    IMPLICIT NONE
     1701
     1702    INTEGER, INTENT(in)                                  :: ncid, d1, d2, d3, d4
     1703    CHARACTER(LEN=*), INTENT(in)                         :: vname
     1704    REAL, DIMENSION(d1,d2,d3,d4), INTENT(out)            :: vals
     1705 
     1706! Local
     1707    INTEGER                                              :: rcode, varid
     1708    LOGICAL                                              :: vfound
     1709
     1710!!!!!!! Variables
     1711! ncid: netCDF file identifier
     1712! d1,d2,d3,d4: shape of the matrix
     1713! vals: values to get
     1714! vname: name of the variable to get
     1715
     1716    fname = 'get_varRK4D_ncunit'
     1717
     1718    vfound = isin_ncunit(ncid, vname)
     1719
     1720    IF (.NOT.vfound) THEN
     1721      msg = "Unit file does not have variable '" // TRIM(vname) // "'"
     1722      CALL ErrMsg(msg, fname, -1)
     1723    END IF
     1724
     1725    rcode = nf90_inq_varid(ncid, vname, varid)
     1726    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1727
     1728    rcode = nf90_get_var(ncid, varid, vals)         
     1729    IF (rcode /= NF90_NOERR) CALL handle_err(rcode)
     1730
     1731  END SUBROUTINE get_varRK4D_ncunit
    4091732
    4101733END MODULE module_generic

  • trunk/tools/module_scientific.f90

    r1654 r1655  
    385385        Nprev = COUNT(INT(tracks(2,:,itt,it)) /= 0)
    386386        finaltracks(1,itrack,it) = itrack*1.
    387         finaltracks(2,itrack,it) = SUM(tracks(3,:,itt,it))/Nprev
    388         finaltracks(3,itrack,it) = SUM(tracks(4,:,itt,it))/Nprev
     387        finaltracks(2,itrack,it) = SUM(tracks(3,:,itt,it))/Nprev*1.
     388        finaltracks(3,itrack,it) = SUM(tracks(4,:,itt,it))/Nprev*1.
    389389        finaltracks(4,itrack,it) = it*1.
    390390      END DO
    … …  
    10501050! [x/y]res resolution along the x and y axis
    10511051! projN: name of the projection
     1052!   'ctsarea': Constant Area
    10521053!   'lon/lat': for regular longitude-latitude
    10531054!   'nadir-sat,[lonNADIR],[latNADIR]': for satellite data with the resolution given at nadir (lonNADIR, latNADIR)
Note: See TracChangeset for help on using the changeset viewer.