Ignore:
Timestamp:
Oct 12, 2023, 10:30:22 AM (15 months ago)
Author:
slebonnois
Message:

BBT : Update for the titan microphysics and cloud model

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.TITAN/libf/muphytitan/asciiread.f90

    r1897 r3083  
    1 ! Copyright Jérémie Burgalat (2010-2015,2017)
    2 !
    3 ! jeremie.burgalat@univ-reims.fr
    4 !
    5 ! This software is a computer program whose purpose is to provide configuration
    6 ! file and command line arguments parsing features to Fortran programs.
    7 !
    8 ! This software is governed by the CeCILL-B license under French law and
    9 ! abiding by the rules of distribution of free software.  You can  use,
    10 ! modify and/ or redistribute the software under the terms of the CeCILL-B
    11 ! license as circulated by CEA, CNRS and INRIA at the following URL
    12 ! "http://www.cecill.info".
    13 !
    14 ! As a counterpart to the access to the source code and  rights to copy,
    15 ! modify and redistribute granted by the license, users are provided only
    16 ! with a limited warranty  and the software's author,  the holder of the
    17 ! economic rights,  and the successive licensors  have only  limited
    18 ! liability.
    19 !
    20 ! In this respect, the user's attention is drawn to the risks associated
    21 ! with loading,  using,  modifying and/or developing or reproducing the
    22 ! software by the user in light of its specific status of free software,
    23 ! that may mean  that it is complicated to manipulate,  and  that  also
    24 ! therefore means  that it is reserved for developers  and  experienced
    25 ! professionals having in-depth computer knowledge. Users are therefore
    26 ! encouraged to load and test the software's suitability as regards their
    27 ! requirements in conditions enabling the security of their systems and/or
    28 ! data to be ensured and,  more generally, to use and operate it in the
    29 ! same conditions as regards security.
    30 !
    31 ! The fact that you are presently reading this means that you have had
    32 ! knowledge of the CeCILL-B license and that you accept its terms.
     1! Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
     2!
     3! This file is part of SWIFT
     4!
     5! Permission is hereby granted, free of charge, to any person obtaining a copy of
     6! this software and associated documentation files (the "Software"), to deal in
     7! the Software without restriction, including without limitation the rights to
     8! use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
     9! the Software, and to permit persons to whom the Software is furnished to do so,
     10! subject to the following conditions:
     11!
     12! The above copyright notice and this permission notice shall be included in all
     13! copies or substantial portions of the Software.
     14!
     15! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
     16! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
     17! FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
     18! COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
     19! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
     20! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
    3321
    3422!! file: asciiread.f90
    3523!! summary: ASCII data file reader source file
    3624!! author: burgalat
    37 !! date: 2013-2015,2017
     25!! date: 2013-2015,2017,2022
    3826MODULE ASCIIREAD
    3927  !! ASCII data file reader module
    … …  
    4230  !! data array from ASCII file.
    4331  !!
    44   !! ``` 
     32  !! ```
    4533  !! FUNCTION read_data(path,data) RESULT(err)
    4634  !! ```
    … …  
    5644  !!   - must use blank space(s) as value delimiter.
    5745  !!   - must have a regular number of columns, that is each data line must
    58   !!     have the same number of columns. 
     46  !!     have the same number of columns.
    5947  !!   - can contains any number of empty lines and/or comment line (i.e. line
    6048  !!     where first non-blank character is "#"). All other lines are assumed
    6149  !!     to be data.
    62   !! Moreover, in the case of 3D data, it must use a SINGLE empty line for "depth" block separator. 
     50  !! Moreover, in the case of 3D data, it must use a SINGLE empty line for "depth" block separator.
    6351  !!
    6452  !! Error occured when:
    … …  
    7664  !! of _R_ lines with _C_ columns. Each block must be separated by a single empty line
    7765  !! and each columns must separated by one or more blank spaces (no tabulation ALLOWED).
    78   !! 
     66  !!
    7967  !! On success, the shape of the 3D output array will be _data(R,C,D)_.
    8068  USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: IOSTAT_END, IOSTAT_EOR
    … …  
    9381  END INTERFACE
    9482
    95   CONTAINS 
     83  CONTAINS
    9684
    9785
    … …  
    10088    !!
    10189    !! The function reads an ASCII file and saves its values in a real(kind=8) 3D-array.
    102     !! 
     90    !!
    10391    !! The input file:
    10492    !!
    10593    !! - must have a regular number of columns, that is each data line must have the same number
    106     !!   of columns (according to the delimiter used). 
     94    !!   of columns (according to the delimiter used).
    10795    !! - must use a SINGLE empty line for "depth" block separator.
    10896    !! - can contains any number of comment lines (i.e. line where first non-blank character is "#").
    10997    !!   All other lines (except empty lines) are assumed to be data.
    110     !! 
     98    !!
    11199    !! Error occured when:
    112100    !!    - Path does not refer to a existing file (-11)
    … …  
    118106    !! with _C_ columns. Each block must be separated by a single empty line and
    119107    !! each columns must separated by one or more blank spaces (no tabulation ALLOWED).
    120     !! 
     108    !!
    121109    !! On success, the shape of the 3D output array will be _output(R,C,D)_.
    122110    !! On error, the 3D output array is __not allocated__.
    123     CHARACTER(len=*), INTENT(in)                             :: path      !! Path of the input data file 
     111    CHARACTER(len=*), INTENT(in)                             :: path      !! Path of the input data file
    124112    REAL(kind=8), INTENT(out), DIMENSION(:,:,:), ALLOCATABLE :: data3d    !! 3D-array with the output values (double precision)
    125113    CHARACTER(len=*), INTENT(in), OPTIONAL                   :: delimiter !! Optional column delimiter(s)
    … …  
    142130      err = error(trim(path)//": no such file",-1) ; RETURN
    143131    ENDIF
    144     lu = free_lun() 
     132    lu = free_lun()
    145133    IF (lu == -1) THEN ; err = error("Cannot find available logical unit...",-1) ; RETURN ; ENDIF
    146134    ! Open file
    147135    OPEN(lu,FILE=TRIM(path),STATUS='OLD',ACTION='READ')
    148136
    149     ! First pass : 
     137    ! First pass :
    150138    ! ------------
    151     !   - get size (rows, columns, depth) 
     139    !   - get size (rows, columns, depth)
    152140    !   - check size consistendcy
    153141    !   - check value type
    154     lc = 0 ; tlc = 0 
    155     ndr = -1 ; ndc = -1 ; ndd = 1 
    156     DO WHILE(readline(lu,line)) 
     142    lc = 0 ; tlc = 0
     143    ndr = -1 ; ndc = -1 ; ndd = 1
     144    DO WHILE(readline(lu,line))
    157145      lm1 = line
    158146      ! Read the line
    … …  
    160148      ! skip comment line
    161149      IF (INDEX(TRIM(ADJUSTL(line)),"#") == 1) CYCLE
    162       ! An empty line: new 2D block 
     150      ! An empty line: new 2D block
    163151      IF (LEN_TRIM(line) == 0) THEN
    164152        ndd = ndd + 1
    … …  
    175163      tlc = tlc + 1
    176164      ! Splits line in words
    177       IF (.NOT.tokenize(line,wrds,zdelim,.true.)) THEN 
     165      IF (.NOT.tokenize(line,wrds,zdelim,.true.)) THEN
    178166        ! cannot tokenize
    179167        err = error(trim(path)//": Cannot parse line "//TRIM(slc),-5)
    … …  
    183171        err = error(trim(path)//": Cannot cast values at line "//TRIM(slc),-5)
    184172        RETURN
    185       ELSEIF (ndc > 0 .AND. ndc /= SIZE(wrds)) THEN 
     173      ELSEIF (ndc > 0 .AND. ndc /= SIZE(wrds)) THEN
    186174        ! current number of columns not equal to last one
    187175        err = error(trim(path)//": Invalid number of columns (line "//TRIM(slc)//")",-5)
    … …  
    204192    ! Allocate memory
    205193    ALLOCATE(data3d(ndr,ndc,ndd))
    206     ir = 0 ; kd = 1 ; 
    207     DO WHILE(readline(lu,line)) 
     194    ir = 0 ; kd = 1 ;
     195    DO WHILE(readline(lu,line))
    208196      IF (INDEX(TRIM(ADJUSTL(line)),"#") == 1) CYCLE
    209197      ir = ir + 1
    210       ! empty line update block subscripts 
     198      ! empty line update block subscripts
    211199      IF (LEN_TRIM(line) == 0) THEN
    212200        kd = kd + 1 ; ir = 0 ; CYCLE
    … …  
    223211    !!
    224212    !! The function reads an ASCII file and saves its values in a real(kind=8) 2D-array.
    225     !! 
     213    !!
    226214    !! The input file:
    227215    !!
    228     !! - can contains any number of empty lines and/or comment line (i.e. line where first 
     216    !! - can contains any number of empty lines and/or comment line (i.e. line where first
    229217    !!   non-blank character is "#"). All other lines are assumed to be data.
    230     !! - must have a regular number of columns, that is each data line must have the same 
    231     !!   number of columns. 
     218    !! - must have a regular number of columns, that is each data line must have the same
     219    !!   number of columns.
    232220    !! - must use blank space(s) as value delimiter.
    233     !! 
     221    !!
    234222    !! Error occured when:
    235223    !!
    … …  
    241229    !! On error, the 2D output array is __not allocated__.
    242230    USE FSYSTEM
    243     CHARACTER(len=*), INTENT(in)                           :: path      !! Path of the input data file 
     231    CHARACTER(len=*), INTENT(in)                           :: path      !! Path of the input data file
    244232    REAL(kind=8), INTENT(out), DIMENSION(:,:), ALLOCATABLE :: data2d    !! 2D-array with the output values (double precision)
    245233    CHARACTER(len=*), INTENT(in), OPTIONAL                 :: delimiter !! Optional column delimiter(s)
    … …  
    258246      err = error(trim(path)//": no such file",-1) ; RETURN
    259247    ENDIF
    260     lu = free_lun() 
     248    lu = free_lun()
    261249    IF (lu == -1) THEN ; err = error("Cannot find available logical unit...",-1) ; RETURN ; ENDIF
    262250    OPEN(lu,FILE=TRIM(path),STATUS='OLD',ACTION='READ')
    … …  
    265253    lc=0 ; vc = 0 ; nc=-1
    266254    ! First pass : get number of row values and checks everything !
    267     DO 
     255    DO
    268256      ! Read the line
    269257      IF (.NOT.readline(lu,line)) EXIT
    … …  
    273261      ! update row counter
    274262      vc = vc + 1
    275       IF (.NOT.tokenize(line,wrds,zdelim,.true.)) THEN 
     263      IF (.NOT.tokenize(line,wrds,zdelim,.true.)) THEN
    276264        ! cannot tokenize
    277265        err = error(trim(path)//": Cannot parse line "//TRIM(slc),-5)
    … …  
    281269        err = error(trim(path)//": Cannot cast values at line "//TRIM(slc),-5)
    282270        RETURN
    283       ELSEIF (nc > 0 .AND. nc /= SIZE(tmp)) THEN 
     271      ELSEIF (nc > 0 .AND. nc /= SIZE(tmp)) THEN
    284272        ! current number of columns not equal to last one
    285273        err = error(trim(path)//": Invalid number of columns (line "//TRIM(slc)//")",-5)
    … …  
    296284    ALLOCATE(data2d(nl,nc))
    297285    ! Second pass : saves values :)
    298     vc = 0 
     286    vc = 0
    299287    DO WHILE(vc <= nl)
    300288      ! Reads the line
    … …  
    315303  FUNCTION readline(lun,line) RESULT(not_eof)
    316304    !! Read a complete line
    317     !! 
    318     !! Each time, it is called, the function reads a complete of the file opened in __lun__ 
     305    !!
     306    !! Each time, it is called, the function reads a complete of the file opened in __lun__
    319307    !! logical unit and returns .false. if EOF has been reached, .true. otherwise.
    320308    !!
    … …  
    331319    !! CLOSE(1)
    332320    !! ```
    333     INTEGER, INTENT(in)                        :: lun  !! Logical unit with the opened file to read. 
    334     CHARACTER(len=:), ALLOCATABLE, INTENT(out) :: line !! Processed line 
     321    INTEGER, INTENT(in)                        :: lun  !! Logical unit with the opened file to read.
     322    CHARACTER(len=:), ALLOCATABLE, INTENT(out) :: line !! Processed line
    335323    LOGICAL  :: not_eof                                !! .true. if EOF has NOT been reached yet, .false. otherwise
    336324    CHARACTER(len=50) :: buf
Note: See TracChangeset for help on using the changeset viewer.