Changeset 1664 in lmdz_wrf for trunk/tools/module_generic.f90


Ignore:
Timestamp:
Oct 4, 2017, 4:00:23 PM (7 years ago)
Author:
lfita
Message:

Making use of the new module `module_NCgeneric.f90'

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/tools/module_generic.f90

    r1660 r1664  
    1717! RangeR_K: Function to provide a range of d1 from 'iniv' to 'endv', of real(r_k) values in a vector
    1818! stoprun: Subroutine to stop running and print a message
    19 ! netCDF related
    20 !!!
    21 ! create_NCfile: Subroutine to create a netCDF file
    22 ! handle_err: Subroutine to provide the error message when something with netCDF went wrong
    23 ! handle_errf: Subroutine to provide the error message when something with netCDF went wrong (including fname)
    24 ! isin_file: Function to tell if a given variable is inside a file
    25 ! isin_ncunit: Function to tell if a given variable is inside a netcdf file unit
    26 ! get_var2dims_file: Function to get the dimensions of a given 2D variable inside a file
    27 ! get_var3dims_file: Function to get the dimensions of a given 3D variable inside a file
    28 ! get_var4dims_file: Function to get the dimensions of a given 4D variable inside a file
    29 ! get_var1dims_ncunit: Function to get the dimensions of a given 1D variable inside a unit of a netCDF file
    30 ! get_var2dims_ncunit: Function to get the dimensions of a given 2D variable inside a unit of a netCDF file
    31 ! get_var3dims_ncunit: Function to get the dimensions of a given 3D variable inside a unit of a netCDF file
    32 ! get_varNdims_file: Function to get the number of dimensions of a given variable inside a file
    33 ! get_varNdims_ncunit: Function to get the number of dimensions of a given variable inside a unit of a netCDF file
    34 ! get_varI1D_ncunit: Subroutine to get a 1D integer variable from a netCDF file unit
    35 ! get_varI2D_ncunit: Subroutine to get a 2D integer variable from a netCDF file unit
    36 ! get_varRK0D_ncunit: Subroutine to get an scalar r_k float variable from a netCDF file unit
    37 ! get_varRK1D_ncunit: Subroutine to get a 1D r_k float variable from a netCDF file unit
    38 ! get_varRK2D_ncunit: Subroutine to get a 2D r_k float variable from a netCDF file unit
    39 ! get_varRK3D_ncunit: Subroutine to get a 3D r_k float variable from a netCDF file unit
    40 ! get_varRK2D_ncunit: Subroutine to get a 4D r_k float variable from a netCDF file unit
    41 ! put_var1D: Subroutine to write on a netCDF file a 1D float variable
    42 ! put_var2D: Subroutine to write on a netCDF file a 2D float variable
    43 ! put_var3D: Subroutine to write on a netCDF file a 3D float variable
    44 ! put_var1Dt: Subroutine to write on a netCDF file a 1D float variable at a given time-step
    45 ! put_var2Dt: Subroutine to write on a netCDF file a 2D float variable at a given time-step
    46 ! put_var3Dt: Subroutine to write on a netCDF file a 3D float variable at a given time-step
    4719
    4820  USE module_definitions
    … …  
    443415  END SUBROUTINE stoprun
    444416
    445 !!!!!!! !!!!!! !!!!! !!!! !!! !! !
    446 ! Netcdf derived
    447 
    448 ! From UNIDATA: https://www.unidata.ucar.edu/software/netcdf/docs/netcdf-f90.html
    449   SUBROUTINE handle_err(st)
    450 ! Subroutine to provide the error message when something with netCDF went wrong
    451 
    452   USE netcdf
    453 
    454   INTEGER, INTENT(in)                                    :: st
    455 
    456 !!!!!!! Variables
    457 ! fn: function name from which it is used
    458 
    459   IF (st /= nf90_noerr) THEN
    460     PRINT *, TRIM(emsg)
    461     PRINT *, '  ' // TRIM(nf90_strerror(st))
    462     STOP "Stopped"
    463   END IF
    464 
    465   END SUBROUTINE handle_err
    466 
    467 ! From UNIDATA: https://www.unidata.ucar.edu/software/netcdf/docs/netcdf-f90.html
    468   SUBROUTINE handle_errf(st, fn)
    469 ! Subroutine to provide the error message when something with netCDF went wrong (including fname)
    470 
    471   USE netcdf
    472 
    473   INTEGER, INTENT(in)                                    :: st
    474   CHARACTER(len=*), INTENT(in)                           :: fn
    475 
    476 !!!!!!! Variables
    477 ! st: netCDF status number
    478 ! fn: function name from which it is used
    479 
    480   IF (st /= nf90_noerr) THEN
    481     PRINT *, TRIM(emsg)
    482     PRINT *, '  ' // TRIM(fn) // ': ' // TRIM(nf90_strerror(st))
    483     STOP "Stopped"
    484   END IF
    485 
    486   END SUBROUTINE handle_errf
    487 
    488   SUBROUTINE create_NCfile(filename, dimsfile, namelistfile, varsfile, ncid)
    489 ! Subroutine to create a netCDF file
    490 
    491     USE netcdf
    492 
    493     IMPLICIT NONE
    494 
    495     INCLUDE 'netcdf.inc'
    496 
    497     CHARACTER(LEN=*), INTENT(IN)                         :: filename, dimsfile, namelistfile, varsfile
    498     INTEGER, INTENT(OUT)                                 :: ncid
    499 
    500 ! Local
    501     INTEGER                                              :: i, j, k, idimnew
    502     INTEGER                                              :: rcode, funit, funit2, ios
    503     INTEGER                                              :: Nvals, dimsize, dimid, iddimnew, Ntotdims
    504     INTEGER                                              :: idvarnew, vartype
    505     CHARACTER(LEN=200)                                   :: message, vd, vs, vdd, val
    506     CHARACTER(LEN=200)                                   :: vname, Lvname, vunits, coornames
    507     CHARACTER(LEN=200), DIMENSION(:), ALLOCATABLE        :: valsline, dimsizes
    508     CHARACTER(LEN=1000)                                  :: line, dimsline
    509     INTEGER, DIMENSION(:), ALLOCATABLE                   :: dimsvar
    510     INTEGER                                              :: Ldimsize, Ldimsvar, dvarL
    511     CHARACTER(LEN=1)                                     :: dvarn
    512 
    513 !!!!!!! Variables
    514 ! filename: name of the file to create
    515 ! dimsfile: ASCII file with the name of the dimensions to create with ('#' for comentaries)
    516 !   [dim name]| [dim orig in WRF]| [dim orig in namelist]| ['unlimited' also, 'namelist' (from namelist parameter)]
    517 ! namelistfile: name of the Namelist file
    518 ! varsfile: ASCII file with the name of the variables to create with ('#' for comentaries)
    519 !   [WRFvarname]| [var name]| [long var name]| [var units]| [var dimensions]
    520 ! ncid: number assigned to the file
    521 
    522     fname = 'create_NCfile'
    523 
    524 ! Opening creation status
    525     rcode = nf90_create(TRIM(filename), NF90_NETCDF4, ncid)
    526     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    527 
    528 ! Reading dimensions file
    529     funit = freeunit()
    530     OPEN(funit, FILE=TRIM(dimsfile), STATUS='old', FORM='formatted', IOSTAT=ios)
    531     message = "Problems to open varibales file '" // TRIM(varsfile) // "' IOSTAT = "//                &
    532       TRIM(ItoS(ios)) // " !!"
    533     IF ( ios /= 0 ) CALL stoprun(message, fname)
    534 
    535     Nvals = 4
    536     IF (ALLOCATED(valsline)) DEALLOCATE(valsline)
    537     ALLOCATE (valsline(Nvals))
    538 
    539 ! Creation of dimensions
    540     idimnew = 3
    541     dimsline = ''
    542     Ntotdims = 0
    543     DO i=1,1000
    544       READ(funit, '(A1000)', END=100)line
    545       IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
    546         CALL split(line,'|',Nvals,valsline)
    547         CALL removeChar(valsline(4),' ')
    548         IF (TRIM(valsline(4)) == 'unlimited') THEN
    549           idimnew = idimnew + 1
    550           dimsize = NF90_UNLIMITED
    551           dimid = idimnew
    552         ELSE IF (TRIM(valsline(4)) == 'namelist') THEN
    553           CALL GetInNamelist(namelistfile, valsline(3), 'I', Ival=dimsize)
    554           SELECT CASE (TRIM(valsline(2)))
    555             CASE ('i')
    556               dimid = 1
    557             CASE ('j')
    558               dimid = 2
    559             CASE ('k')
    560               dimid = 3
    561             CASE ('t')
    562               dimid = 4
    563               dimsize = NF90_UNLIMITED
    564             CASE DEFAULT
    565               idimnew = idimnew + 1
    566               dimid = idimnew
    567           END SELECT
    568         END IF
    569         rcode = nf90_def_dim(ncid, TRIM(valsline(1)), dimsize, dimid)
    570         IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    571         vs = valsline(2)
    572         CALL removeChar(vs, ' ')
    573         CALL attachString(dimsline, TRIM(vs) // ':' // TRIM(ItoS(dimid)) // ';')
    574         Ntotdims = Ntotdims + 1
    575       END IF
    576     END DO
    577 
    578  100 CONTINUE
    579     CLOSE(funit)
    580 
    581 ! Sort of python dictionary for [dimn]:[dimsize]...
    582     IF (ALLOCATED(dimsizes)) DEALLOCATE(dimsizes)
    583     ALLOCATE(dimsizes(Ntotdims))
    584     CALL split(dimsline,';',Ntotdims,dimsizes)
    585 
    586 ! Reading variables file
    587     funit = freeunit()
    588     OPEN(funit, FILE=TRIM(varsfile), STATUS='old', FORM='formatted', IOSTAT=ios)
    589    
    590     message = "Problems to open varibales file '" // TRIM(varsfile) // "' IOSTAT = "//                &
    591       TRIM(ItoS(ios)) // " !!"
    592     IF ( ios /= 0 ) CALL stoprun(message, fname)
    593 
    594     Nvals = 6
    595     IF (ALLOCATED(valsline)) DEALLOCATE(valsline)
    596     ALLOCATE (valsline(Nvals))
    597 
    598 ! Defining variables
    599     idvarnew = 1
    600     DO i=1,1000
    601       READ(funit, '(A1000)', END=150)line
    602       IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
    603         CALL split(line,'|',Nvals,valsline)
    604         vtype: SELECT CASE (TRIM(valsline(6)))
    605           CASE ('B')
    606             vartype = NF_BYTE
    607           CASE ('C')
    608             vartype = NF_CHAR
    609           CASE ('I')
    610             vartype = NF_SHORT
    611           CASE ('I16')
    612             vartype = NF_INT
    613           CASE ('R')
    614             vartype = NF_FLOAT
    615           CASE ('R16')
    616             vartype = NF_DOUBLE
    617         END SELECT vtype
    618 
    619         vd = valsline(5)
    620         CALL removeChar(vd, ' ')
    621         Ldimsvar = LEN_TRIM(vd)
    622         IF (ALLOCATED(dimsvar)) DEALLOCATE(dimsvar)
    623         ALLOCATE(dimsvar(Ldimsvar))
    624 
    625 ! Variable's dimensions
    626         coornames = ''
    627         DO j=1, Ldimsvar
    628           DO k=1, Ntotdims
    629             IF (dimsizes(k)(1:1) == vd(j:j)) THEN
    630               Ldimsize = LEN_TRIM(dimsizes(k))
    631               vdd = dimsizes(k)(3:Ldimsize)
    632               dimsvar(j) = StoI(vdd)
    633 ! Too complicated to assign dimvarname... (or too lazy)
    634 !              coornames = coornames //
    635               CYCLE
    636             END IF
    637           END DO
    638         END DO
    639         vname = valsline(2)
    640         CALL removeChar(vname, ' ')
    641         vartype = 5
    642        
    643         rcode = nf90_def_var(ncid, vname, vartype, dimsvar, idvarnew)
    644         IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    645 
    646 ! Adding attributes
    647         rcode = nf90_put_att(ncid, idvarnew, 'standard_name', TRIM(valsline(2)))
    648         IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    649         rcode = nf90_put_att(ncid, idvarnew, 'long_name', TRIM(valsline(3)))
    650         IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    651         rcode = nf90_put_att(ncid, idvarnew, 'units', TRIM(valsline(4)))
    652         IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    653 
    654         idvarnew = idvarnew + 1
    655       END IF
    656     END DO
    657 
    658  150 CONTINUE
    659     CLOSE(funit)
    660 
    661     rcode = NF90_ENDDEF(ncid)
    662     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    663 
    664     DEALLOCATE(valsline)
    665     DEALLOCATE(dimsizes)
    666 
    667   END SUBROUTINE create_NCfile
    668 
    669   FUNCTION get_var2dims_file(filename, varname)
    670 ! Function to get the dimensions of a given 2D variable inside a file
    671 
    672     USE netcdf
    673 
    674     IMPLICIT NONE
    675 
    676     CHARACTER(LEN=*), INTENT(in)                         :: filename, varname
    677 ! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
    678     INTEGER, DIMENSION(2)                                :: get_var2dims_file
    679 
    680 ! Local
    681     INTEGER                                              :: nid, vid, Ndims
    682     INTEGER                                              :: rcode
    683     INTEGER, DIMENSION(2)                                :: dimsid
    684 
    685 !!!!!!! Variables
    686 ! filename: name of the file to open
    687 ! varname: name of the variable
    688 
    689     fname = 'get_var2dims_file'
    690     !PRINT *,TRIM(fname)
    691 
    692 ! Opening creation status
    693     rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
    694     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    695 
    696     rcode = nf90_inq_varid(nid, varname, vid)
    697     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    698 
    699     rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
    700     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    701 
    702     IF (Ndims /= 2) THEN
    703       msg = "variable '" // TRIM(varname) // "' has not 2 dimensions!!"
    704       CALL stoprun(msg, fname)
    705     END IF
    706 
    707     rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
    708     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    709 
    710     rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var2dims_file(1))
    711     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    712 
    713     rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var2dims_file(2))
    714     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    715 
    716     rcode = NF90_CLOSE(nid)
    717     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    718 
    719   END FUNCTION get_var2dims_file
    720 
    721   FUNCTION get_var3dims_file(filename, varname)
    722 ! Function to get the dimensions of a given 3D variable inside a file
    723 
    724     USE netcdf
    725 
    726     IMPLICIT NONE
    727 
    728     CHARACTER(LEN=*), INTENT(in)                         :: filename, varname
    729 ! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
    730     INTEGER, DIMENSION(3)                                :: get_var3dims_file
    731 
    732 ! Local
    733     INTEGER                                              :: nid, vid, Ndims
    734     INTEGER                                              :: rcode
    735     INTEGER, DIMENSION(3)                                :: dimsid
    736 
    737 
    738 !!!!!!! Variables
    739 ! filename: name of the file to open
    740 ! varname: name of the variable
    741 
    742     fname = 'get_var3dims_file'
    743     !PRINT *,TRIM(fname)
    744 
    745 ! Opening creation status
    746     rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
    747     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    748 
    749     rcode = nf90_inq_varid(nid, varname, vid)
    750     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    751 
    752     rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
    753     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    754 
    755     IF (Ndims /= 3) THEN
    756       msg = "variable '" // TRIM(varname) // "' has not 3 dimensions!!"
    757       CALL stoprun(msg, fname)
    758     END IF
    759 
    760     rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
    761     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    762 
    763     rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var3dims_file(1))
    764     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    765 
    766     rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var3dims_file(2))
    767     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    768 
    769     rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var3dims_file(3))
    770     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    771 
    772     rcode = NF90_CLOSE(nid)
    773     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    774 
    775   END FUNCTION get_var3dims_file
    776 
    777   FUNCTION get_var1dims_ncunit(nid, varname)
    778 ! Function to get the dimensions of a given 1D variable inside a unit of a netCDF file
    779 
    780     USE netcdf
    781 
    782     IMPLICIT NONE
    783 
    784     INTEGER, INTENT(in)                                  :: nid
    785     CHARACTER(LEN=*), INTENT(in)                         :: varname
    786 ! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
    787     INTEGER, DIMENSION(1)                                :: get_var1dims_ncunit
    788 
    789 ! Local
    790     INTEGER                                              :: vid, Ndims
    791     INTEGER                                              :: rcode
    792     INTEGER, DIMENSION(1)                                :: dimsid
    793 
    794 
    795 !!!!!!! Variables
    796 ! filename: name of the file to open
    797 ! varname: name of the variable
    798 
    799     fname = 'get_var1dims_ncunit'
    800     !PRINT *,TRIM(fname)
    801 
    802     rcode = nf90_inq_varid(nid, varname, vid)
    803     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    804 
    805     rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
    806     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    807 
    808     IF (Ndims /= 1) THEN
    809       msg = "variable '" // TRIM(varname) // "' has not 1 dimensions!!"
    810       CALL stoprun(msg, fname)
    811     END IF
    812 
    813     rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
    814     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    815 
    816     rcode = nf90_inquire_dimension(nid, dimsid(1), name=msg)
    817 
    818     rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var1dims_ncunit(1))
    819     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    820 
    821   END FUNCTION get_var1dims_ncunit
    822 
    823   FUNCTION get_var2dims_ncunit(nid, varname)
    824 ! Function to get the dimensions of a given 2D variable inside a unit of a netCDF file
    825 
    826     USE netcdf
    827 
    828     IMPLICIT NONE
    829 
    830     INTEGER, INTENT(in)                                  :: nid
    831     CHARACTER(LEN=*), INTENT(in)                         :: varname
    832 ! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
    833     INTEGER, DIMENSION(2)                                :: get_var2dims_ncunit
    834 
    835 ! Local
    836     INTEGER                                              :: vid, Ndims
    837     INTEGER                                              :: rcode
    838     INTEGER, DIMENSION(2)                                :: dimsid
    839 
    840 
    841 !!!!!!! Variables
    842 ! filename: name of the file to open
    843 ! varname: name of the variable
    844 
    845     fname = 'get_var2dims_ncunit'
    846     !PRINT *,TRIM(fname)
    847 
    848     rcode = nf90_inq_varid(nid, varname, vid)
    849     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    850 
    851     rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
    852     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    853 
    854     IF (Ndims /= 2) THEN
    855       msg = "variable '" // TRIM(varname) // "' has not 2 dimensions!!"
    856       CALL stoprun(msg, fname)
    857     END IF
    858 
    859     rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
    860     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    861 
    862     rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var2dims_ncunit(1))
    863     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    864 
    865     rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var2dims_ncunit(2))
    866     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    867 
    868   END FUNCTION get_var2dims_ncunit
    869 
    870   FUNCTION get_var3dims_ncunit(nid, varname)
    871 ! Function to get the dimensions of a given 3D variable inside a unit of a netCDF file
    872 
    873     USE netcdf
    874 
    875     IMPLICIT NONE
    876 
    877     INTEGER, INTENT(in)                                  :: nid
    878     CHARACTER(LEN=*), INTENT(in)                         :: varname
    879 ! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
    880     INTEGER, DIMENSION(3)                                :: get_var3dims_ncunit
    881 
    882 ! Local
    883     INTEGER                                              :: vid, Ndims
    884     INTEGER                                              :: rcode
    885     INTEGER, DIMENSION(3)                                :: dimsid
    886 
    887 
    888 !!!!!!! Variables
    889 ! filename: name of the file to open
    890 ! varname: name of the variable
    891 
    892     fname = 'get_var3dims_ncunit'
    893     !PRINT *,TRIM(fname)
    894 
    895     rcode = nf90_inq_varid(nid, varname, vid)
    896     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    897 
    898     rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
    899     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    900 
    901     IF (Ndims /= 3) THEN
    902       msg = "variable '" // TRIM(varname) // "' has not 3 dimensions!!"
    903       CALL stoprun(msg, fname)
    904     END IF
    905 
    906     rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
    907     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    908 
    909     rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var3dims_ncunit(1))
    910     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    911 
    912     rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var3dims_ncunit(2))
    913     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    914 
    915     rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var3dims_ncunit(3))
    916     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    917 
    918   END FUNCTION get_var3dims_ncunit
    919 
    920   FUNCTION get_var4dims_file(filename, varname)
    921 ! Function to get the dimensions of a given 4D variable inside a file
    922 
    923     USE netcdf
    924 
    925     IMPLICIT NONE
    926 
    927     CHARACTER(LEN=*), INTENT(in)                         :: filename, varname
    928 ! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
    929     INTEGER, DIMENSION(4)                                :: get_var4dims_file
    930 
    931 ! Local
    932     INTEGER                                              :: nid, vid, Ndims
    933     INTEGER                                              :: rcode
    934     INTEGER, DIMENSION(4)                                :: dimsid
    935 
    936 
    937 !!!!!!! Variables
    938 ! filename: name of the file to open
    939 ! varname: name of the variable
    940 
    941     fname = 'get_var4dims_file'
    942     !PRINT *,TRIM(fname)
    943 
    944 ! Opening creation status
    945     rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
    946     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    947 
    948     rcode = nf90_inq_varid(nid, varname, vid)
    949     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    950 
    951     rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
    952     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    953 
    954     IF (Ndims /= 4) THEN
    955       msg = "variable '" // TRIM(varname) // "' has not 4 dimensions!!"
    956       CALL stoprun(msg, fname)
    957     END IF
    958 
    959     rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
    960     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    961 
    962     rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = get_var4dims_file(1))
    963     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    964 
    965     rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = get_var4dims_file(2))
    966     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    967 
    968     rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = get_var4dims_file(3))
    969     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    970 
    971     rcode = nf90_inquire_dimension(nid, dimsid(4), LEN = get_var4dims_file(4))
    972     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    973 
    974     rcode = NF90_CLOSE(nid)
    975     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    976 
    977   END FUNCTION get_var4dims_file
    978 
    979   INTEGER FUNCTION get_varNdims_file(filename, varname)
    980 ! Function to get the number of dimensions of a given variable inside a file
    981 
    982     USE netcdf
    983 
    984     IMPLICIT NONE
    985 
    986     CHARACTER(LEN=*), INTENT(in)                         :: filename, varname
    987 
    988 ! Local
    989     INTEGER                                              :: nid, vid
    990     INTEGER                                              :: rcode
    991 
    992 !!!!!!! Variables
    993 ! filename: name of the file to open
    994 ! varname: name of the variable
    995 
    996     fname = 'get_varNdims_file'
    997     !PRINT *,TRIM(fname)
    998 
    999 ! Opening creation status
    1000     rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
    1001     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1002 
    1003     rcode = nf90_inq_varid(nid, varname, vid)
    1004     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1005 
    1006     rcode = nf90_inquire_variable(nid, vid, NDIMS = get_varNdims_file)
    1007     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1008 
    1009     rcode = NF90_CLOSE(nid)
    1010     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1011 
    1012   END FUNCTION get_varNdims_file
    1013 
    1014   INTEGER FUNCTION get_varNdims_ncunit(nid, varname)
    1015 ! Function to get the number of dimensions of a given variable inside a unit of a netCDF file
    1016 
    1017     USE netcdf
    1018 
    1019     IMPLICIT NONE
    1020 
    1021     INTEGER, INTENT(in)                                  :: nid
    1022     CHARACTER(LEN=*), INTENT(in)                         :: varname
    1023 
    1024 ! Local
    1025     INTEGER                                              :: vid
    1026     INTEGER                                              :: rcode
    1027 
    1028 !!!!!!! Variables
    1029 ! filename: name of the file to open
    1030 ! varname: name of the variable
    1031 
    1032     fname = 'get_varNdims_ncunit'
    1033     !PRINT *,TRIM(fname)
    1034 
    1035     rcode = nf90_inq_varid(nid, varname, vid)
    1036     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1037 
    1038     rcode = nf90_inquire_variable(nid, vid, NDIMS = get_varNdims_ncunit)
    1039     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1040 
    1041   END FUNCTION get_varNdims_ncunit
    1042 
    1043 LOGICAL FUNCTION isin_file(filename, varname)
    1044 ! Function to tell if a given variable is inside a file
    1045 
    1046     USE netcdf
    1047 
    1048     IMPLICIT NONE
    1049 
    1050     CHARACTER(LEN=*), INTENT(in)                         :: filename, varname
    1051 
    1052 ! Local
    1053     INTEGER                                              :: nid, vid, Ndims, Nvars
    1054     INTEGER                                              :: iv, rcode
    1055     CHARACTER(LEN=1000)                                  :: varinfile
    1056 
    1057 !!!!!!! Variables
    1058 ! filename: name of the file to open
    1059 ! varname: name of the variable
    1060 
    1061     fname = 'isin_file'
    1062 
    1063 ! Opening creation status
    1064     rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
    1065     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1066 
    1067     rcode = nf90_inquire(nid, Ndims, Nvars)
    1068     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1069 
    1070     DO iv=1, Nvars
    1071       rcode = nf90_inquire_variable(nid, iv, name=varinfile)
    1072       IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1073       IF (TRIM(varinfile) == TRIM(varname)) THEN
    1074         isin_file = .TRUE.
    1075         EXIT
    1076       ELSE
    1077         isin_file = .FALSE.
    1078       END IF
    1079     END DO
    1080 
    1081     rcode = NF90_CLOSE(nid)
    1082     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1083    
    1084   END FUNCTION isin_file
    1085 
    1086 LOGICAL FUNCTION isin_ncunit(nid, varname)
    1087 ! Function to tell if a given variable is inside a netcdf file unit
    1088 
    1089     USE netcdf
    1090 
    1091     IMPLICIT NONE
    1092 
    1093     INTEGER, INTENT(in)                                  :: nid
    1094     CHARACTER(LEN=*), INTENT(in)                         :: varname
    1095 
    1096 ! Local
    1097     INTEGER                                              :: vid, Ndims, Nvars
    1098     INTEGER                                              :: iv, rcode
    1099     CHARACTER(LEN=1000)                                  :: varinfile
    1100 
    1101 !!!!!!! Variables
    1102 ! nid: number of the opened netCDF
    1103 ! varname: name of the variable
    1104 
    1105     fname = 'isin_ncunit'
    1106 
    1107     rcode = nf90_inquire(nid, Ndims, Nvars)
    1108     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1109 
    1110     DO iv=1, Nvars
    1111       rcode = nf90_inquire_variable(nid, iv, name=varinfile)
    1112       IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1113       IF (TRIM(varinfile) == TRIM(varname)) THEN
    1114         isin_ncunit = .TRUE.
    1115         EXIT
    1116       ELSE
    1117         isin_ncunit = .FALSE.
    1118       END IF
    1119     END DO
    1120    
    1121   END FUNCTION isin_ncunit
    1122 
    1123   SUBROUTINE put_var1D(ncid, d1, vals, vname, filevarn)
    1124 ! Subroutine to write on a netCDF file a 1D float variable
    1125 
    1126     USE netcdf
    1127 
    1128     IMPLICIT NONE
    1129 
    1130     INTEGER, INTENT(IN)                                  :: ncid, d1
    1131     REAL, DIMENSION(d1), INTENT(IN)                      :: vals
    1132     CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
    1133  
    1134 ! Local
    1135     INTEGER                                              :: funit, i, idvarnew, ios
    1136     INTEGER                                              :: Nvals, rcode, varid
    1137     CHARACTER(LEN=50)                                    :: ncvarname
    1138     CHARACTER(LEN=1000)                                  :: line
    1139     CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
    1140     LOGICAL                                              :: vfound
    1141 
    1142 !!!!!!! Variables
    1143 ! ncid: netCDF file identifier
    1144 ! d1: shape of the matrix
    1145 ! vals: values to include
    1146 ! vname: name of the variable in the model to be included
    1147 ! filevarn: name of the ASCII file with the information about the variables
    1148     fname = 'put_var1D'
    1149 
    1150 ! Reading variables file
    1151     funit = freeunit()
    1152     OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
    1153     msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
    1154       TRIM(ItoS(ios)) // " !!"
    1155     IF ( ios /= 0 ) CALL stoprun(msg, fname)
    1156 
    1157     Nvals = 6
    1158 
    1159     idvarnew = 1
    1160     vfound = .FALSE.
    1161     DO i=1,1000
    1162       READ(funit, '(A1000)', END=150)line
    1163       IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
    1164         CALL split(line,'|',Nvals,valsline)
    1165         IF (TRIM(vname) == TRIM(valsline(1))) THEN
    1166           ncvarname = TRIM(valsline(2))
    1167           CALL removeChar(ncvarname, ' ')
    1168           rcode = nf90_inq_varid(ncid, ncvarname, varid)
    1169           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1170 
    1171           rcode = nf90_put_var(ncid, varid, vals)         
    1172           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1173           vfound = .TRUE.
    1174           CYCLE
    1175         END IF
    1176       END IF
    1177     END DO
    1178 
    1179  150 CONTINUE
    1180 
    1181     CLOSE(funit)
    1182     IF (.NOT.vfound) THEN
    1183       msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
    1184         "' !!"
    1185       CALL stoprun(msg, fname)
    1186     END IF
    1187 
    1188   END SUBROUTINE put_var1D
    1189 
    1190   SUBROUTINE put_var2D(ncid, d1, d2, vals, vname, filevarn)
    1191 ! Subroutine to write on a netCDF file a 2D float variable
    1192 
    1193     USE netcdf
    1194 
    1195     IMPLICIT NONE
    1196 
    1197     INTEGER, INTENT(IN)                                  :: ncid, d1, d2
    1198     REAL, DIMENSION(d1,d2), INTENT(IN)                   :: vals
    1199     CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
    1200  
    1201 ! Local
    1202     INTEGER                                              :: funit, i, idvarnew, ios
    1203     INTEGER                                              :: Nvals, rcode, varid
    1204     CHARACTER(LEN=50)                                    :: ncvarname
    1205     CHARACTER(LEN=1000)                                  :: line
    1206     CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
    1207     LOGICAL                                              :: vfound
    1208 
    1209 !!!!!!! Variables
    1210 ! ncid: netCDF file identifier
    1211 ! d1,d2: shape of the matrix
    1212 ! vals: values to include
    1213 ! vname: name of the variable in the model to be included
    1214 ! filevarn: name of the ASCII file with the information about the variables
    1215     fname = 'put_var2D'
    1216 
    1217 ! Reading variables file
    1218     funit = freeunit()
    1219     OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
    1220     msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
    1221       TRIM(ItoS(ios)) // " !!"
    1222     IF ( ios /= 0 ) CALL stoprun(msg, fname)
    1223 
    1224     Nvals = 6
    1225 
    1226     idvarnew = 1
    1227     vfound = .FALSE.
    1228     DO i=1,1000
    1229       READ(funit, '(A1000)', END=150)line
    1230       IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
    1231         CALL split(line,'|',Nvals,valsline)
    1232         IF (TRIM(vname) == TRIM(valsline(1))) THEN
    1233           ncvarname = TRIM(valsline(2))
    1234           CALL removeChar(ncvarname, ' ')
    1235           rcode = nf90_inq_varid(ncid, ncvarname, varid)
    1236           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1237 
    1238           rcode = nf90_put_var(ncid, varid, vals)         
    1239           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1240           vfound = .TRUE.
    1241           CYCLE
    1242         END IF
    1243       END IF
    1244     END DO
    1245 
    1246  150 CONTINUE
    1247 
    1248     CLOSE(funit)
    1249     IF (.NOT.vfound) THEN
    1250       msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
    1251         "' !!"
    1252       CALL stoprun(msg, fname)
    1253     END IF
    1254 
    1255   END SUBROUTINE put_var2D
    1256 
    1257   SUBROUTINE put_var3D(ncid, d1, d2, d3, vals, vname, filevarn)
    1258 ! Subroutine to write on a netCDF file a 3D float variable
    1259 
    1260     USE netcdf
    1261 
    1262     IMPLICIT NONE
    1263 
    1264     INTEGER, INTENT(IN)                                  :: ncid, d1, d2, d3
    1265     REAL, DIMENSION(d1,d2,d3), INTENT(IN)                :: vals
    1266     CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
    1267  
    1268 ! Local
    1269     INTEGER                                              :: funit, i, idvarnew, ios
    1270     INTEGER                                              :: Nvals, rcode, varid
    1271     CHARACTER(LEN=50)                                    :: ncvarname
    1272     CHARACTER(LEN=1000)                                  :: line
    1273     CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
    1274     LOGICAL                                              :: vfound
    1275 
    1276 !!!!!!! Variables
    1277 ! ncid: netCDF file identifier
    1278 ! d1,d2,d3: shape of the matrix
    1279 ! vals: values to include
    1280 ! vname: name of the variable in the model to be included
    1281 ! filevarn: name of the ASCII file with the information about the variables
    1282     fname = 'put_var3D'
    1283 
    1284 ! Reading variables file
    1285     funit = freeunit()
    1286     OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
    1287     msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
    1288       TRIM(ItoS(ios)) // " !!"
    1289     IF ( ios /= 0 ) CALL stoprun(msg, fname)
    1290 
    1291     Nvals = 6
    1292 
    1293     idvarnew = 1
    1294     vfound = .FALSE.
    1295     DO i=1,1000
    1296       READ(funit, '(A1000)', END=150)line
    1297       IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
    1298         CALL split(line,'|',Nvals,valsline)
    1299         IF (TRIM(vname) == TRIM(valsline(1))) THEN
    1300           ncvarname = TRIM(valsline(2))
    1301           CALL removeChar(ncvarname, ' ')
    1302           rcode = nf90_inq_varid(ncid, ncvarname, varid)
    1303           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1304 
    1305           rcode = nf90_put_var(ncid, varid, vals)         
    1306           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1307           vfound = .TRUE.
    1308           CYCLE
    1309         END IF
    1310       END IF
    1311     END DO
    1312 
    1313  150 CONTINUE
    1314     CLOSE(funit)
    1315 
    1316     IF (.NOT.vfound) THEN
    1317       msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
    1318         "' !!"
    1319       CALL stoprun(msg, fname)
    1320     END IF
    1321 
    1322   END SUBROUTINE put_var3D
    1323 
    1324   SUBROUTINE put_var1Dt(ncid, d1, vals, vname, filevarn, it)
    1325 ! Subroutine to write on a netCDF file a 1D float variable at a given time-step
    1326 
    1327     USE netcdf
    1328 
    1329     IMPLICIT NONE
    1330 
    1331     INTEGER, INTENT(IN)                                  :: ncid, d1, it
    1332     REAL, DIMENSION(d1), INTENT(IN)                      :: vals
    1333     CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
    1334  
    1335 ! Local
    1336     INTEGER                                              :: funit, i, idvarnew, ios
    1337     INTEGER                                              :: Nvals, rcode, varid
    1338     CHARACTER(LEN=50)                                    :: ncvarname
    1339     CHARACTER(LEN=1000)                                  :: line
    1340     CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
    1341     LOGICAL                                              :: vfound
    1342 
    1343 !!!!!!! Variables
    1344 ! ncid: netCDF file identifier
    1345 ! d1: shape of the matrix
    1346 ! vals: values to include
    1347 ! vname: name of the variable in the model to be included
    1348 ! filevarn: name of the ASCII file with the information about the variables
    1349 ! it: time-step to add
    1350 
    1351     fname = 'put_var1Dt'
    1352 
    1353 ! Reading variables file
    1354     funit = freeunit()
    1355     OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
    1356     msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
    1357       TRIM(ItoS(ios)) // " !!"
    1358     IF ( ios /= 0 ) CALL stoprun(msg, fname)
    1359 
    1360     Nvals = 6
    1361 
    1362     idvarnew = 1
    1363     vfound = .FALSE.
    1364     DO i=1,1000
    1365       READ(funit, '(A1000)', END=150)line
    1366       IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
    1367         CALL split(line,'|',Nvals,valsline)
    1368         IF (TRIM(vname) == TRIM(valsline(1))) THEN
    1369           ncvarname = TRIM(valsline(2))
    1370           CALL removeChar(ncvarname, ' ')
    1371           rcode = nf90_inq_varid(ncid, ncvarname, varid)
    1372           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1373 
    1374           rcode = nf90_put_var(ncid, varid, vals, start=(/1,it/), count=(/d1,1/))
    1375           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1376           vfound = .TRUE.
    1377           CYCLE
    1378         END IF
    1379       END IF
    1380     END DO
    1381 
    1382  150 CONTINUE
    1383 
    1384     CLOSE(funit)
    1385     IF (.NOT.vfound) THEN
    1386       msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
    1387         "' !!"
    1388       CALL stoprun(msg, fname)
    1389     END IF
    1390 
    1391   END SUBROUTINE put_var1Dt
    1392 
    1393   SUBROUTINE put_var2Dt(ncid, d1, d2, vals, vname, filevarn, it)
    1394 ! Subroutine to write on a netCDF file a 2D float variable at a given time-step
    1395 
    1396     USE netcdf
    1397 
    1398     IMPLICIT NONE
    1399 
    1400     INTEGER, INTENT(IN)                                  :: ncid, d1, d2, it
    1401     REAL, DIMENSION(d1), INTENT(IN)                      :: vals
    1402     CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
    1403  
    1404 ! Local
    1405     INTEGER                                              :: funit, i, idvarnew, ios
    1406     INTEGER                                              :: Nvals, rcode, varid
    1407     CHARACTER(LEN=50)                                    :: ncvarname
    1408     CHARACTER(LEN=1000)                                  :: line
    1409     CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
    1410     LOGICAL                                              :: vfound
    1411 
    1412 !!!!!!! Variables
    1413 ! ncid: netCDF file identifier
    1414 ! d1: shape of the matrix
    1415 ! vals: values to include
    1416 ! vname: name of the variable in the model to be included
    1417 ! filevarn: name of the ASCII file with the information about the variables
    1418 ! it: time-step to add
    1419 
    1420     fname = 'put_var2Dt'
    1421 
    1422 ! Reading variables file
    1423     funit = freeunit()
    1424     OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
    1425     msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
    1426       TRIM(ItoS(ios)) // " !!"
    1427     IF ( ios /= 0 ) CALL stoprun(msg, fname)
    1428 
    1429     Nvals = 6
    1430 
    1431     idvarnew = 1
    1432     vfound = .FALSE.
    1433     DO i=1,1000
    1434       READ(funit, '(A1000)', END=150)line
    1435       IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
    1436         CALL split(line,'|',Nvals,valsline)
    1437         IF (TRIM(vname) == TRIM(valsline(1))) THEN
    1438           ncvarname = TRIM(valsline(2))
    1439           CALL removeChar(ncvarname, ' ')
    1440           rcode = nf90_inq_varid(ncid, ncvarname, varid)
    1441           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1442 
    1443           rcode = nf90_put_var(ncid, varid, vals, start=(/1,1,it/), count=(/d1,d2,1/))
    1444           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1445           vfound = .TRUE.
    1446           CYCLE
    1447         END IF
    1448       END IF
    1449     END DO
    1450 
    1451  150 CONTINUE
    1452 
    1453     CLOSE(funit)
    1454     IF (.NOT.vfound) THEN
    1455       msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
    1456         "' !!"
    1457       CALL stoprun(msg, fname)
    1458     END IF
    1459 
    1460   END SUBROUTINE put_var2Dt
    1461 
    1462   SUBROUTINE put_var3Dt(ncid, d1, d2, d3, vals, vname, filevarn, it)
    1463 ! Subroutine to write on a netCDF file a 3D float variable at a given time-step
    1464 
    1465     USE netcdf
    1466 
    1467     IMPLICIT NONE
    1468 
    1469     INTEGER, INTENT(IN)                                  :: ncid, d1, d2, d3, it
    1470     REAL, DIMENSION(d1), INTENT(IN)                      :: vals
    1471     CHARACTER(LEN=*), INTENT(IN)                         :: vname, filevarn
    1472  
    1473 ! Local
    1474     INTEGER                                              :: funit, i, idvarnew, ios
    1475     INTEGER                                              :: Nvals, rcode, varid
    1476     CHARACTER(LEN=50)                                    :: ncvarname
    1477     CHARACTER(LEN=1000)                                  :: line
    1478     CHARACTER(LEN=200), DIMENSION(6)                     :: valsline
    1479     LOGICAL                                              :: vfound
    1480 
    1481 !!!!!!! Variables
    1482 ! ncid: netCDF file identifier
    1483 ! d1,d2,d3: shape of the matrix
    1484 ! vals: values to include
    1485 ! vname: name of the variable in the model to be included
    1486 ! filevarn: name of the ASCII file with the information about the variables
    1487 ! it: time-step to add
    1488 
    1489     fname = 'put_var3Dt'
    1490 
    1491 ! Reading variables file
    1492     funit = freeunit()
    1493     OPEN(funit, FILE=TRIM(filevarn), STATUS='old', FORM='formatted', IOSTAT=ios)
    1494     msg = "Problems to open variables file '" // TRIM(filevarn) // "' IOSTAT = "//                    &
    1495       TRIM(ItoS(ios)) // " !!"
    1496     IF ( ios /= 0 ) CALL stoprun(msg, fname)
    1497 
    1498     Nvals = 6
    1499 
    1500     idvarnew = 1
    1501     vfound = .FALSE.
    1502     DO i=1,1000
    1503       READ(funit, '(A1000)', END=150)line
    1504       IF (line(1:1) /= '#' .AND. LEN_TRIM(line) > 1) THEN
    1505         CALL split(line,'|',Nvals,valsline)
    1506         IF (TRIM(vname) == TRIM(valsline(1))) THEN
    1507           ncvarname = TRIM(valsline(2))
    1508           CALL removeChar(ncvarname, ' ')
    1509           rcode = nf90_inq_varid(ncid, ncvarname, varid)
    1510           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1511 
    1512           rcode = nf90_put_var(ncid, varid, vals, start=(/1,1,1,it/), count=(/d1,d2,d3,1/))
    1513           IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1514           vfound = .TRUE.
    1515           CYCLE
    1516         END IF
    1517       END IF
    1518     END DO
    1519 
    1520  150 CONTINUE
    1521 
    1522     CLOSE(funit)
    1523     IF (.NOT.vfound) THEN
    1524       msg = "variables file '" // TRIM(filevarn) // "' does not have varible '" // TRIM(vname) //     &
    1525         "' !!"
    1526       CALL stoprun(msg, fname)
    1527     END IF
    1528 
    1529   END SUBROUTINE put_var3Dt
    1530 
    1531   SUBROUTINE get_varI1D_ncunit(ncid, d1, vname, vals)
    1532 ! Subroutine to get a 1D integer variable from a netCDF file unit
    1533 
    1534     USE netcdf
    1535 
    1536     IMPLICIT NONE
    1537 
    1538     INTEGER, INTENT(in)                                  :: ncid, d1
    1539     CHARACTER(LEN=*), INTENT(in)                         :: vname
    1540     INTEGER, DIMENSION(d1), INTENT(out)                  :: vals
    1541  
    1542 ! Local
    1543     INTEGER                                              :: rcode, varid
    1544     LOGICAL                                              :: vfound
    1545 
    1546 !!!!!!! Variables
    1547 ! ncid: netCDF file identifier
    1548 ! d1: shape of the matrix
    1549 ! vals: values to get
    1550 ! vname: name of the variable to getºº
    1551 
    1552     fname = 'get_varI1D_ncunit'
    1553 
    1554     vfound = isin_ncunit(ncid, vname)
    1555 
    1556     IF (.NOT.vfound) THEN
    1557       msg = "Unit file does not have variable '" // TRIM(vname) // "'"
    1558       CALL ErrMsg(msg, fname, -1)
    1559     END IF
    1560 
    1561     rcode = nf90_inq_varid(ncid, vname, varid)
    1562     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1563 
    1564     rcode = nf90_get_var(ncid, varid, vals)         
    1565     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1566 
    1567   END SUBROUTINE get_varI1D_ncunit
    1568 
    1569   SUBROUTINE get_varI2D_ncunit(ncid, d1, d2, vname, vals)
    1570 ! Subroutine to get a 2D integer variable from a netCDF file unit
    1571 
    1572     USE netcdf
    1573 
    1574     IMPLICIT NONE
    1575 
    1576     INTEGER, INTENT(in)                                  :: ncid, d1, d2
    1577     CHARACTER(LEN=*), INTENT(in)                         :: vname
    1578     INTEGER, DIMENSION(d1,d2), INTENT(out)               :: vals
    1579  
    1580 ! Local
    1581     INTEGER                                              :: rcode, varid
    1582     LOGICAL                                              :: vfound
    1583 
    1584 !!!!!!! Variables
    1585 ! ncid: netCDF file identifier
    1586 ! d1: shape of the matrix
    1587 ! vals: values to get
    1588 ! vname: name of the variable to get
    1589 
    1590     fname = 'get_varI2D_ncunit'
    1591 
    1592     vfound = isin_ncunit(ncid, vname)
    1593 
    1594     IF (.NOT.vfound) THEN
    1595       msg = "Unit file does not have variable '" // TRIM(vname) // "'"
    1596       CALL ErrMsg(msg, fname, -1)
    1597     END IF
    1598 
    1599     rcode = nf90_inq_varid(ncid, vname, varid)
    1600     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1601 
    1602     rcode = nf90_get_var(ncid, varid, vals)         
    1603     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1604 
    1605   END SUBROUTINE get_varI2D_ncunit
    1606 
    1607   SUBROUTINE get_varI3D_ncunit(ncid, d1, d2, d3, vname, vals)
    1608 ! Subroutine to get a 2D integer variable from a netCDF file unit
    1609 
    1610     USE netcdf
    1611 
    1612     IMPLICIT NONE
    1613 
    1614     INTEGER, INTENT(in)                                  :: ncid, d1, d2, d3
    1615     CHARACTER(LEN=*), INTENT(in)                         :: vname
    1616     INTEGER, DIMENSION(d1,d2,d3), INTENT(out)            :: vals
    1617  
    1618 ! Local
    1619     INTEGER                                              :: rcode, varid
    1620     LOGICAL                                              :: vfound
    1621 
    1622 !!!!!!! Variables
    1623 ! ncid: netCDF file identifier
    1624 ! d1: shape of the matrix
    1625 ! vals: values to get
    1626 ! vname: name of the variable to get
    1627 
    1628     fname = 'get_varI3D_ncunit'
    1629 
    1630     vfound = isin_ncunit(ncid, vname)
    1631 
    1632     IF (.NOT.vfound) THEN
    1633       msg = "Unit file does not have variable '" // TRIM(vname) // "'"
    1634       CALL ErrMsg(msg, fname, -1)
    1635     END IF
    1636 
    1637     rcode = nf90_inq_varid(ncid, vname, varid)
    1638     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1639 
    1640     rcode = nf90_get_var(ncid, varid, vals)         
    1641     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1642 
    1643   END SUBROUTINE get_varI3D_ncunit
    1644 
    1645   SUBROUTINE get_varRK0D_ncunit(ncid, vname, vals)
    1646 ! Subroutine to get an scalar r_k float variable from a netCDF file unit
    1647 
    1648     USE netcdf
    1649 
    1650     IMPLICIT NONE
    1651 
    1652     INTEGER, INTENT(in)                                  :: ncid
    1653     CHARACTER(LEN=*), INTENT(in)                         :: vname
    1654     REAL, INTENT(out)                                    :: vals
    1655  
    1656 ! Local
    1657     INTEGER                                              :: rcode, varid
    1658     LOGICAL                                              :: vfound
    1659 
    1660 !!!!!!! Variables
    1661 ! ncid: netCDF file identifier
    1662 ! vals: values to get
    1663 ! vname: name of the variable to get
    1664 
    1665     fname = 'get_varRK0D_ncunit'
    1666 
    1667     vfound = isin_ncunit(ncid, vname)
    1668 
    1669     IF (.NOT.vfound) THEN
    1670       msg = "Unit file does not have variable '" // TRIM(vname) // "'"
    1671       CALL ErrMsg(msg, fname, -1)
    1672     END IF
    1673 
    1674     rcode = nf90_inq_varid(ncid, vname, varid)
    1675     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1676 
    1677     rcode = nf90_get_var(ncid, varid, vals)         
    1678     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1679 
    1680   END SUBROUTINE get_varRK0D_ncunit
    1681 
    1682   SUBROUTINE get_varRK1D_ncunit(ncid, d1, vname, vals)
    1683 ! Subroutine to get a 1D r_k float variable from a netCDF file unit
    1684 
    1685     USE netcdf
    1686 
    1687     IMPLICIT NONE
    1688 
    1689     INTEGER, INTENT(in)                                  :: ncid, d1
    1690     CHARACTER(LEN=*), INTENT(in)                         :: vname
    1691     REAL, DIMENSION(d1), INTENT(out)                     :: vals
    1692  
    1693 ! Local
    1694     INTEGER                                              :: rcode, varid
    1695     LOGICAL                                              :: vfound
    1696 
    1697 !!!!!!! Variables
    1698 ! ncid: netCDF file identifier
    1699 ! d1: shape of the matrix
    1700 ! vals: values to get
    1701 ! vname: name of the variable to get
    1702 
    1703     fname = 'get_varRK1D_ncunit'
    1704 
    1705     vfound = isin_ncunit(ncid, vname)
    1706 
    1707     IF (.NOT.vfound) THEN
    1708       msg = "Unit file does not have variable '" // TRIM(vname) // "'"
    1709       CALL ErrMsg(msg, fname, -1)
    1710     END IF
    1711 
    1712     rcode = nf90_inq_varid(ncid, vname, varid)
    1713     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1714 
    1715     rcode = nf90_get_var(ncid, varid, vals)         
    1716     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1717 
    1718   END SUBROUTINE get_varRK1D_ncunit
    1719 
    1720   SUBROUTINE get_varRK2D_ncunit(ncid, d1, d2, vname, vals)
    1721 ! Subroutine to get a 2D r_k float variable from a netCDF file unit
    1722 
    1723     USE netcdf
    1724 
    1725     IMPLICIT NONE
    1726 
    1727     INTEGER, INTENT(in)                                  :: ncid, d1, d2
    1728     CHARACTER(LEN=*), INTENT(in)                         :: vname
    1729     REAL, DIMENSION(d1,d2), INTENT(out)                  :: vals
    1730  
    1731 ! Local
    1732     INTEGER                                              :: rcode, varid
    1733     LOGICAL                                              :: vfound
    1734 
    1735 !!!!!!! Variables
    1736 ! ncid: netCDF file identifier
    1737 ! d1,d2: shape of the matrix
    1738 ! vals: values to get
    1739 ! vname: name of the variable to get
    1740 
    1741     fname = 'get_varRK2D_ncunit'
    1742 
    1743     vfound = isin_ncunit(ncid, vname)
    1744 
    1745     IF (.NOT.vfound) THEN
    1746       msg = "Unit file does not have variable '" // TRIM(vname) // "'"
    1747       CALL ErrMsg(msg, fname, -1)
    1748     END IF
    1749 
    1750     rcode = nf90_inq_varid(ncid, vname, varid)
    1751     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1752 
    1753     rcode = nf90_get_var(ncid, varid, vals)         
    1754     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1755 
    1756   END SUBROUTINE get_varRK2D_ncunit
    1757 
    1758   SUBROUTINE get_varRK3D_ncunit(ncid, d1, d2, d3, vname, vals)
    1759 ! Subroutine to get a 3D r_k float variable from a netCDF file unit
    1760 
    1761     USE netcdf
    1762 
    1763     IMPLICIT NONE
    1764 
    1765     INTEGER, INTENT(in)                                  :: ncid, d1, d2, d3
    1766     CHARACTER(LEN=*), INTENT(in)                         :: vname
    1767     REAL, DIMENSION(d1,d2,d3), INTENT(out)               :: vals
    1768  
    1769 ! Local
    1770     INTEGER                                              :: rcode, varid
    1771     LOGICAL                                              :: vfound
    1772 
    1773 !!!!!!! Variables
    1774 ! ncid: netCDF file identifier
    1775 ! d1,d2,d3: shape of the matrix
    1776 ! vals: values to get
    1777 ! vname: name of the variable to get
    1778 
    1779     fname = 'get_varRK3D_ncunit'
    1780 
    1781     vfound = isin_ncunit(ncid, vname)
    1782 
    1783     IF (.NOT.vfound) THEN
    1784       msg = "Unit file does not have variable '" // TRIM(vname) // "'"
    1785       CALL ErrMsg(msg, fname, -1)
    1786     END IF
    1787 
    1788     rcode = nf90_inq_varid(ncid, vname, varid)
    1789     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1790 
    1791     rcode = nf90_get_var(ncid, varid, vals)         
    1792     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1793 
    1794   END SUBROUTINE get_varRK3D_ncunit
    1795 
    1796   SUBROUTINE get_varRK4D_ncunit(ncid, d1, d2, d3, d4, vname, vals)
    1797 ! Subroutine to get a 4D r_k float variable from a netCDF file unit
    1798 
    1799     USE netcdf
    1800 
    1801     IMPLICIT NONE
    1802 
    1803     INTEGER, INTENT(in)                                  :: ncid, d1, d2, d3, d4
    1804     CHARACTER(LEN=*), INTENT(in)                         :: vname
    1805     REAL, DIMENSION(d1,d2,d3,d4), INTENT(out)            :: vals
    1806  
    1807 ! Local
    1808     INTEGER                                              :: rcode, varid
    1809     LOGICAL                                              :: vfound
    1810 
    1811 !!!!!!! Variables
    1812 ! ncid: netCDF file identifier
    1813 ! d1,d2,d3,d4: shape of the matrix
    1814 ! vals: values to get
    1815 ! vname: name of the variable to get
    1816 
    1817     fname = 'get_varRK4D_ncunit'
    1818 
    1819     vfound = isin_ncunit(ncid, vname)
    1820 
    1821     IF (.NOT.vfound) THEN
    1822       msg = "Unit file does not have variable '" // TRIM(vname) // "'"
    1823       CALL ErrMsg(msg, fname, -1)
    1824     END IF
    1825 
    1826     rcode = nf90_inq_varid(ncid, vname, varid)
    1827     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1828 
    1829     rcode = nf90_get_var(ncid, varid, vals)         
    1830     IF (rcode /= NF90_NOERR) CALL handle_errf(rcode, fname)
    1831 
    1832   END SUBROUTINE get_varRK4D_ncunit
    1833 
    1834417END MODULE module_generic
Note: See TracChangeset for help on using the changeset viewer.