Changeset 536

Timestamp:

01/30/09 12:46:27 (16 years ago)

Author:

bellier

Message:

New version with dynamic extension

File:

• IOIPSL/trunk/src/getincom.f90 (modified) (8 diffs)

IOIPSL/trunk/src/getincom.f90

@@ -57 +57 @@
   INTEGER,SAVE      :: nbfiles
 !-
-  INTEGER,PARAMETER :: max_lines=500,l_n=30
-  INTEGER,SAVE :: nb_lines
-  CHARACTER(LEN=100),DIMENSION(max_lines),SAVE :: fichier
-  INTEGER,DIMENSION(max_lines),SAVE :: fromfile,compline
-  CHARACTER(LEN=l_n),DIMENSION(max_lines),SAVE :: targetlist
+  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
+  INTEGER,SAVE :: nb_lines,i_txtsize=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier
+  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline
 !-
   INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15
@@ -102 +102 @@
   TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab
 !-
-  INTEGER,SAVE,ALLOCATABLE :: i_mem(:)
-  INTEGER,SAVE             :: i_memsize=0, i_mempos=0
-  REAL,SAVE,ALLOCATABLE :: r_mem(:)
-  INTEGER,SAVE          :: r_memsize=0, r_mempos=0
-  CHARACTER(LEN=100),SAVE,ALLOCATABLE :: c_mem(:)
-  INTEGER,SAVE             :: c_memsize=0, c_mempos=0
-  LOGICAL,SAVE,ALLOCATABLE :: l_mem(:)
-  INTEGER,SAVE             :: l_memsize=0, l_mempos=0
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem
+  INTEGER,SAVE :: i_memsize=0, i_mempos=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem
+  INTEGER,SAVE :: r_memsize=0, r_mempos=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem
+  INTEGER,SAVE :: c_memsize=0, c_mempos=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem
+  INTEGER,SAVE :: l_memsize=0, l_mempos=0
 !-
 CONTAINS
@@ -1013 +1013 @@
   IF (allread == 0) THEN
 !-- Allocate a first set of memory.
-    CALL getin_allockeys
+    CALL getin_alloctxt ()
+    CALL getin_allockeys ()
     CALL getin_allocmem (k_i,0)
     CALL getin_allocmem (k_r,0)
@@ -1022 +1023 @@
     filelist(1) = 'run.def'
     current = 1
-    nb_lines = 0
 !--
     DO WHILE (current <= nbfiles)
@@ -1212 +1212 @@
 !-- We are working on a new line of input
 !-
+    IF (nb_lines+1 > i_txtsize) THEN
+      CALL getin_alloctxt ()
+    ENDIF
     nb_lines = nb_lines+1
-    IF (nb_lines > max_lines) THEN
-      CALL ipslerr (3,'getin_decrypt', &
- &     'Too many lines in the run.def files.', &
- &     'You need to increase', &
- &     'the parameter max_lines in the module getincom.')
-    ENDIF
 !-
 !-- First we solve the issue of conpressed information. Once
@@ -1310 +1307 @@
         blk = INDEX(TRIM(tmp_str),' ')
 !-
+        IF (nb_lines+1 > i_txtsize) THEN
+          CALL getin_alloctxt ()
+        ENDIF
         nb_lines = nb_lines+1
-        IF (nb_lines > max_lines) THEN
-          CALL ipslerr (3,'getin_decrypt', &
- &         'Too many lines in the run.def files.', &
- &         'You need to increase', &
- &         'the parameter max_lines in the module getincom.')
-        ENDIF
         nbve = nbve+1
         WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
@@ -1422 +1416 @@
 !-
   TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
-  INTEGER,ALLOCATABLE :: tmp_int(:)
   CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:)
 !-
@@ -1620 +1613 @@
 !----------------------------
 END SUBROUTINE getin_allocmem
+!-
+!===
+!-
+SUBROUTINE getin_alloctxt ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:)
+  CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:)
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp1,c_tmp2
+!---------------------------------------------------------------------
+  IF (i_txtsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtslab
+    ALLOCATE(fichier(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(targetlist(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(fromfile(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(compline(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    nb_lines = 0
+    i_txtsize = i_txtslab
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtsize
+    WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab
+    ALLOCATE(tmp_fic(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_fic', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_fic(1:i_txtsize) = fichier(1:i_txtsize)
+    DEALLOCATE(fichier)
+    ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fichier(1:i_txtsize) = tmp_fic(1:i_txtsize)
+    DEALLOCATE(tmp_fic)
+!---
+    ALLOCATE(tmp_tgl(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_tgl', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize)
+    DEALLOCATE(targetlist)
+    ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize)
+    DEALLOCATE(tmp_tgl)
+!---
+    ALLOCATE(tmp_int(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_int', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_int(1:i_txtsize) = fromfile(1:i_txtsize)
+    DEALLOCATE(fromfile)
+    ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fromfile(1:i_txtsize) = tmp_int(1:i_txtsize)
+!---
+    tmp_int(1:i_txtsize) = compline(1:i_txtsize)
+    DEALLOCATE(compline)
+    ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    compline(1:i_txtsize) = tmp_int(1:i_txtsize)
+    DEALLOCATE(tmp_int)
+!---
+    i_txtsize = i_txtsize+i_txtslab
+  ENDIF
+!----------------------------
+END SUBROUTINE getin_alloctxt
 !-
 !===