Changeset 536 for IOIPSL/trunk/src


Ignore:
Timestamp:
01/30/09 12:46:27 (13 years ago)
Author:
bellier
Message:

New version with dynamic extension

File:
1 edited

Legend:

Unmodified
Added
Removed
  • IOIPSL/trunk/src/getincom.f90

    r386 r536  
    5757  INTEGER,SAVE      :: nbfiles 
    5858!- 
    59   INTEGER,PARAMETER :: max_lines=500,l_n=30 
    60   INTEGER,SAVE :: nb_lines 
    61   CHARACTER(LEN=100),DIMENSION(max_lines),SAVE :: fichier 
    62   INTEGER,DIMENSION(max_lines),SAVE :: fromfile,compline 
    63   CHARACTER(LEN=l_n),DIMENSION(max_lines),SAVE :: targetlist 
     59  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30 
     60  INTEGER,SAVE :: nb_lines,i_txtsize=0 
     61  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier 
     62  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist 
     63  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline 
    6464!- 
    6565  INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15 
     
    102102  TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab 
    103103!- 
    104   INTEGER,SAVE,ALLOCATABLE :: i_mem(:) 
    105   INTEGER,SAVE             :: i_memsize=0, i_mempos=0 
    106   REAL,SAVE,ALLOCATABLE :: r_mem(:) 
    107   INTEGER,SAVE          :: r_memsize=0, r_mempos=0 
    108   CHARACTER(LEN=100),SAVE,ALLOCATABLE :: c_mem(:) 
    109   INTEGER,SAVE             :: c_memsize=0, c_mempos=0 
    110   LOGICAL,SAVE,ALLOCATABLE :: l_mem(:) 
    111   INTEGER,SAVE             :: l_memsize=0, l_mempos=0 
     104  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem 
     105  INTEGER,SAVE :: i_memsize=0, i_mempos=0 
     106  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem 
     107  INTEGER,SAVE :: r_memsize=0, r_mempos=0 
     108  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem 
     109  INTEGER,SAVE :: c_memsize=0, c_mempos=0 
     110  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem 
     111  INTEGER,SAVE :: l_memsize=0, l_mempos=0 
    112112!- 
    113113CONTAINS 
     
    10131013  IF (allread == 0) THEN 
    10141014!-- Allocate a first set of memory. 
    1015     CALL getin_allockeys 
     1015    CALL getin_alloctxt () 
     1016    CALL getin_allockeys () 
    10161017    CALL getin_allocmem (k_i,0) 
    10171018    CALL getin_allocmem (k_r,0) 
     
    10221023    filelist(1) = 'run.def' 
    10231024    current = 1 
    1024     nb_lines = 0 
    10251025!-- 
    10261026    DO WHILE (current <= nbfiles) 
     
    12121212!-- We are working on a new line of input 
    12131213!- 
     1214    IF (nb_lines+1 > i_txtsize) THEN 
     1215      CALL getin_alloctxt () 
     1216    ENDIF 
    12141217    nb_lines = nb_lines+1 
    1215     IF (nb_lines > max_lines) THEN 
    1216       CALL ipslerr (3,'getin_decrypt', & 
    1217  &     'Too many lines in the run.def files.', & 
    1218  &     'You need to increase', & 
    1219  &     'the parameter max_lines in the module getincom.') 
    1220     ENDIF 
    12211218!- 
    12221219!-- First we solve the issue of conpressed information. Once 
     
    13101307        blk = INDEX(TRIM(tmp_str),' ') 
    13111308!- 
     1309        IF (nb_lines+1 > i_txtsize) THEN 
     1310          CALL getin_alloctxt () 
     1311        ENDIF 
    13121312        nb_lines = nb_lines+1 
    1313         IF (nb_lines > max_lines) THEN 
    1314           CALL ipslerr (3,'getin_decrypt', & 
    1315  &         'Too many lines in the run.def files.', & 
    1316  &         'You need to increase', & 
    1317  &         'the parameter max_lines in the module getincom.') 
    1318         ENDIF 
    13191313        nbve = nbve+1 
    13201314        WRITE(UNIT=cnt,FMT=c_i_fmt) nbve 
     
    14221416!- 
    14231417  TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab 
    1424   INTEGER,ALLOCATABLE :: tmp_int(:) 
    14251418  CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:) 
    14261419!- 
     
    16201613!---------------------------- 
    16211614END SUBROUTINE getin_allocmem 
     1615!- 
     1616!=== 
     1617!- 
     1618SUBROUTINE getin_alloctxt () 
     1619!--------------------------------------------------------------------- 
     1620  IMPLICIT NONE 
     1621!- 
     1622  CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:) 
     1623  CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:) 
     1624  INTEGER,ALLOCATABLE :: tmp_int(:) 
     1625!- 
     1626  INTEGER :: ier 
     1627  CHARACTER(LEN=20) :: c_tmp1,c_tmp2 
     1628!--------------------------------------------------------------------- 
     1629  IF (i_txtsize == 0) THEN 
     1630!--- 
     1631!-- Nothing exists in memory arrays and it is easy to do. 
     1632!--- 
     1633    WRITE (UNIT=c_tmp1,FMT=*) i_txtslab 
     1634    ALLOCATE(fichier(i_txtslab),stat=ier) 
     1635    IF (ier /= 0) THEN 
     1636      CALL ipslerr (3,'getin_alloctxt', & 
     1637 &     'Can not allocate fichier', & 
     1638 &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ') 
     1639    ENDIF 
     1640!--- 
     1641    ALLOCATE(targetlist(i_txtslab),stat=ier) 
     1642    IF (ier /= 0) THEN 
     1643      CALL ipslerr (3,'getin_alloctxt', & 
     1644 &     'Can not allocate targetlist', & 
     1645 &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ') 
     1646    ENDIF 
     1647!--- 
     1648    ALLOCATE(fromfile(i_txtslab),stat=ier) 
     1649    IF (ier /= 0) THEN 
     1650      CALL ipslerr (3,'getin_alloctxt', & 
     1651 &     'Can not allocate fromfile', & 
     1652 &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ') 
     1653    ENDIF 
     1654!--- 
     1655    ALLOCATE(compline(i_txtslab),stat=ier) 
     1656    IF (ier /= 0) THEN 
     1657      CALL ipslerr (3,'getin_alloctxt', & 
     1658 &     'Can not allocate compline', & 
     1659 &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ') 
     1660    ENDIF 
     1661!--- 
     1662    nb_lines = 0 
     1663    i_txtsize = i_txtslab 
     1664  ELSE 
     1665!--- 
     1666!-- There is something already in the memory, 
     1667!-- we need to transfer and reallocate. 
     1668!--- 
     1669    WRITE (UNIT=c_tmp1,FMT=*) i_txtsize 
     1670    WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab 
     1671    ALLOCATE(tmp_fic(i_txtsize),stat=ier) 
     1672    IF (ier /= 0) THEN 
     1673      CALL ipslerr (3,'getin_alloctxt', & 
     1674 &     'Can not allocate tmp_fic', & 
     1675 &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ') 
     1676    ENDIF 
     1677    tmp_fic(1:i_txtsize) = fichier(1:i_txtsize) 
     1678    DEALLOCATE(fichier) 
     1679    ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier) 
     1680    IF (ier /= 0) THEN 
     1681      CALL ipslerr (3,'getin_alloctxt', & 
     1682 &     'Can not allocate fichier', & 
     1683 &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ') 
     1684    ENDIF 
     1685    fichier(1:i_txtsize) = tmp_fic(1:i_txtsize) 
     1686    DEALLOCATE(tmp_fic) 
     1687!--- 
     1688    ALLOCATE(tmp_tgl(i_txtsize),stat=ier) 
     1689    IF (ier /= 0) THEN 
     1690      CALL ipslerr (3,'getin_alloctxt', & 
     1691 &     'Can not allocate tmp_tgl', & 
     1692 &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ') 
     1693    ENDIF 
     1694    tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize) 
     1695    DEALLOCATE(targetlist) 
     1696    ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier) 
     1697    IF (ier /= 0) THEN 
     1698      CALL ipslerr (3,'getin_alloctxt', & 
     1699 &     'Can not allocate targetlist', & 
     1700 &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ') 
     1701    ENDIF 
     1702    targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize) 
     1703    DEALLOCATE(tmp_tgl) 
     1704!--- 
     1705    ALLOCATE(tmp_int(i_txtsize),stat=ier) 
     1706    IF (ier /= 0) THEN 
     1707      CALL ipslerr (3,'getin_alloctxt', & 
     1708 &     'Can not allocate tmp_int', & 
     1709 &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ') 
     1710    ENDIF 
     1711    tmp_int(1:i_txtsize) = fromfile(1:i_txtsize) 
     1712    DEALLOCATE(fromfile) 
     1713    ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier) 
     1714    IF (ier /= 0) THEN 
     1715      CALL ipslerr (3,'getin_alloctxt', & 
     1716 &     'Can not allocate fromfile', & 
     1717 &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ') 
     1718    ENDIF 
     1719    fromfile(1:i_txtsize) = tmp_int(1:i_txtsize) 
     1720!--- 
     1721    tmp_int(1:i_txtsize) = compline(1:i_txtsize) 
     1722    DEALLOCATE(compline) 
     1723    ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier) 
     1724    IF (ier /= 0) THEN 
     1725      CALL ipslerr (3,'getin_alloctxt', & 
     1726 &     'Can not allocate compline', & 
     1727 &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ') 
     1728    ENDIF 
     1729    compline(1:i_txtsize) = tmp_int(1:i_txtsize) 
     1730    DEALLOCATE(tmp_int) 
     1731!--- 
     1732    i_txtsize = i_txtsize+i_txtslab 
     1733  ENDIF 
     1734!---------------------------- 
     1735END SUBROUTINE getin_alloctxt 
    16221736!- 
    16231737!=== 
Note: See TracChangeset for help on using the changeset viewer.