Changeset 536 for IOIPSL/trunk
- Timestamp:
- 01/30/09 12:46:27 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
IOIPSL/trunk/src/getincom.f90
r386 r536 57 57 INTEGER,SAVE :: nbfiles 58 58 !- 59 INTEGER,PARAMETER :: max_lines=500,l_n=3060 INTEGER,SAVE :: nb_lines 61 CHARACTER(LEN=100), DIMENSION(max_lines),SAVE:: fichier62 INTEGER,DIMENSION(max_lines),SAVE :: fromfile,compline63 CHARACTER(LEN=l_n),DIMENSION(max_lines),SAVE :: targetlist59 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 64 64 !- 65 65 INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15 … … 102 102 TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab 103 103 !- 104 INTEGER,SAVE,ALLOCATABLE :: i_mem(:)105 INTEGER,SAVE 106 REAL,SAVE,ALLOCATABLE :: r_mem(:)107 INTEGER,SAVE 108 CHARACTER(LEN=100),SAVE,ALLOCATABLE :: c_mem(:)109 INTEGER,SAVE 110 LOGICAL,SAVE,ALLOCATABLE :: l_mem(:)111 INTEGER,SAVE 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 112 112 !- 113 113 CONTAINS … … 1013 1013 IF (allread == 0) THEN 1014 1014 !-- Allocate a first set of memory. 1015 CALL getin_allockeys 1015 CALL getin_alloctxt () 1016 CALL getin_allockeys () 1016 1017 CALL getin_allocmem (k_i,0) 1017 1018 CALL getin_allocmem (k_r,0) … … 1022 1023 filelist(1) = 'run.def' 1023 1024 current = 1 1024 nb_lines = 01025 1025 !-- 1026 1026 DO WHILE (current <= nbfiles) … … 1212 1212 !-- We are working on a new line of input 1213 1213 !- 1214 IF (nb_lines+1 > i_txtsize) THEN 1215 CALL getin_alloctxt () 1216 ENDIF 1214 1217 nb_lines = nb_lines+1 1215 IF (nb_lines > max_lines) THEN1216 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 ENDIF1221 1218 !- 1222 1219 !-- First we solve the issue of conpressed information. Once … … 1310 1307 blk = INDEX(TRIM(tmp_str),' ') 1311 1308 !- 1309 IF (nb_lines+1 > i_txtsize) THEN 1310 CALL getin_alloctxt () 1311 ENDIF 1312 1312 nb_lines = nb_lines+1 1313 IF (nb_lines > max_lines) THEN1314 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 ENDIF1319 1313 nbve = nbve+1 1320 1314 WRITE(UNIT=cnt,FMT=c_i_fmt) nbve … … 1422 1416 !- 1423 1417 TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab 1424 INTEGER,ALLOCATABLE :: tmp_int(:)1425 1418 CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:) 1426 1419 !- … … 1620 1613 !---------------------------- 1621 1614 END SUBROUTINE getin_allocmem 1615 !- 1616 !=== 1617 !- 1618 SUBROUTINE 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 !---------------------------- 1735 END SUBROUTINE getin_alloctxt 1622 1736 !- 1623 1737 !===
Note: See TracChangeset
for help on using the changeset viewer.