Changeset 11 for IOIPSL/trunk/src


Ignore:
Timestamp:
03/12/07 17:01:04 (18 years ago)
Author:
bellier
Message:

JB: on the road to svn

Location:
IOIPSL/trunk/src
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • IOIPSL/trunk/src/AA_make

    • Property svn:keywords set to Id
    r4 r11  
    11#- 
    2 #- $Id: AA_make,v 2.16 2006/01/18 06:34:11 adm Exp $ 
     2#- $Id$ 
    33#- 
    4 #-Q- sx6nec F_O = $(F_D) $(F_P) -C vsafe -size_t64 -I $(MODDIR) 
     4MAKE_NAM = $(MAKE) 
     5ifneq ($(MAKE_NAM),$(M_K)) 
     6 @$(error You must invoke this Makefile with the $(M_K) command) 
     7endif 
     8USER_DIR = $(shell pwd) 
     9MAKE_DIR = '??' 
     10ifneq ($(USER_DIR),$(MAKE_DIR)) 
     11 @$(error You must invoke this Makefile from its directory) 
     12endif 
     13#- 
    514#-Q- sxdkrz F_O = $(F_D) $(F_P) -C vsafe -size_t64 -I $(MODDIR) 
    615#-Q- eshpux F_O = $(F_D) $(F_P) -C vsafe -I $(MODDIR) 
    … …  
    918#--------------------------------------------------------------------- 
    1019 
    11 PRF_PRC = !\#-P- 
    12 DEF_PRC = $(PRF_PRC)$(D_P) 
    13 SRC_PRC   = defprec.f90 
    14 MODS1     = $(SRC_PRC)    \ 
    15             errioipsl.f90 \ 
    16             stringop.f90  \ 
    17             mathelp.f90   \ 
    18             getincom.f90  \ 
    19             calendar.f90  \ 
    20             fliocom.f90   \ 
    21             flincom.f90   \ 
    22             histcom.f90   \ 
    23             restcom.f90   \ 
    24             ioipsl.f90 
     20MODS1 = defprec.f90   \ 
     21        errioipsl.f90 \ 
     22        stringop.f90  \ 
     23        mathelp.f90   \ 
     24        getincom.f90  \ 
     25        calendar.f90  \ 
     26        fliocom.f90   \ 
     27        flincom.f90   \ 
     28        histcom.f90   \ 
     29        restcom.f90   \ 
     30        ioipsl.f90 
    2531OBJSMODS1 = $(MODS1:.f90=.o) 
    2632 
    27 all: $(SRC_PRC) $(MODEL_LIB)($(OBJSMODS1)) 
     33all: $(MODEL_LIB)($(OBJSMODS1)) 
    2834        @echo IOIPSL is OK 
    2935 
    30 $(SRC_PRC): def.prec 
    31         (sed -e "s/^$(DEF_PRC) */  /g" def.prec | \ 
    32          grep -v $(PRF_PRC) > $(SRC_PRC)) 
    33  
    3436.PRECIOUS : $(MODEL_LIB) 
    35 #-Q- sxnec  .PRECIOUS : $(SXMODEL_LIB) 
    36 #-Q- sx6nec .PRECIOUS : $(SXMODEL_LIB) 
    3737#-Q- sxdkrz .PRECIOUS : $(SXMODEL_LIB) 
    3838#-Q- eshpux .PRECIOUS : $(SXMODEL_LIB) 
    … …  
    4242        $(A_C) $(MODEL_LIB) $*.o 
    4343#-Q- sgi6       mv $(shell echo $* | tr '[:lower:]' '[:upper:]').mod $(MODDIR) 
    44 #-Q- sxnec      $(A_X) $(SXMODEL_LIB) $*.o 
    45 #-Q- sxnec      mv $*.mod $(MODDIR) 
    46 #-Q- sx6nec     $(A_X) $(SXMODEL_LIB) $*.o 
    47 #-Q- sx6nec     mv $*.mod $(MODDIR) 
     44#-Q- sx8brodie  mv $*.mod $(MODDIR) 
     45#-Q- sx8mercure mv $*.mod $(MODDIR) 
    4846#-Q- sxdkrz     $(A_X) $(SXMODEL_LIB) $*.o 
    4947#-Q- sxdkrz     mv $*.mod $(MODDIR) 
    … …  
    5452 
    5553clean: 
    56 #-Q- sxnec      $(RM) $(SXMODEL_LIB) 
    57 #-Q- sx6nec     $(RM) $(SXMODEL_LIB) 
    5854#-Q- sxdkrz     $(RM) $(SXMODEL_LIB) 
    5955#-Q- eshpux     $(RM) $(SXMODEL_LIB) 
     56        $(RM) $(MODEL_LIB) 
    6057        $(RM) *.*~ Makefile~ core *.o *.mod i.*.L *.L i.*.f90 
    6158        $(RM) $(MODDIR)/*.mod $(MODDIR)/*.M *.M 
    62         $(RM) $(MODEL_LIB) $(SRC_PRC) 
    6359 
    6460#- Specific dependencies 
    6561 
    66 $(MODEL_LIB)(errioipsl.o):  \ 
     62$(MODEL_LIB)(errioipsl.o):   \ 
    6763  $(MODEL_LIB)(defprec.o) 
    6864 
    69 $(MODEL_LIB)(stringop.o):  \ 
     65$(MODEL_LIB)(stringop.o):    \ 
    7066  $(MODEL_LIB)(defprec.o) 
    7167 
    … …  
    7470  $(MODEL_LIB)(stringop.o) 
    7571 
    76 $(MODEL_LIB)(getincom.o):  \ 
     72$(MODEL_LIB)(getincom.o):    \ 
    7773  $(MODEL_LIB)(stringop.o) 
    7874 
    … …  
    9692  $(MODEL_LIB)(stringop.o)   \ 
    9793  $(MODEL_LIB)(mathelp.o)    \ 
    98   $(MODEL_LIB)(calendar.o)  \ 
     94  $(MODEL_LIB)(calendar.o)   \ 
    9995  $(MODEL_LIB)(fliocom.o) 
    10096 
    … …  
    10399  $(MODEL_LIB)(stringop.o)   \ 
    104100  $(MODEL_LIB)(mathelp.o)    \ 
    105   $(MODEL_LIB)(calendar.o)  \ 
     101  $(MODEL_LIB)(calendar.o)   \ 
    106102  $(MODEL_LIB)(fliocom.o) 
    107103 

  • IOIPSL/trunk/src/AA_make.ldef

    • Property svn:keywords set to Id
    r4 r11  
    11#- 
    2 #- $Id: AA_make.ldef,v 2.6 2006/01/18 06:17:31 adm Exp $ 
     2#- $Id$ 
    33#- 
    44#--------------------------------------------------------------------- 
    … …  
    1111MODDIR = $(LIBDIR) 
    1212#--------------------------------------------------------------------- 
    13 #-P- I4R4     D_P = I4R4 
    14 #-P- I4R8     D_P = I4R8 
    15 #-P- I8R8     D_P = I8R8 
    16 #-P- ??       D_P = I4R4 
    17 #-Q- fjvpp    #-P- ??   D_P = I4R8 
    18 #-Q- sxnec    #-P- ??   D_P = I4R8 
    19 #-Q- sx6nec   #-P- ??   D_P = I4R8 
    20 #-Q- sxdkrz   #-P- ??   D_P = I4R8 
    21 #-Q- aix      #-P- ??   D_P = I4R8 
    22 #-Q- eshpux   #-P- ??   D_P = I4R8 
    2313P_P = 
    2414MODEL_LIB = $(LIBDIR)/libioipsl.a 
    2515SXMODEL_LIB = $(MODEL_LIB) 
    26 #-Q- sxnec  SXMODEL_LIB = $(LIBDIR)/libsxioipsl.a 
    27 #-Q- sx6nec SXMODEL_LIB = $(LIBDIR)/libsxioipsl.a 
    2816#-Q- sxdkrz SXMODEL_LIB = $(LIBDIR)/libsxioipsl.a 
    2917#-Q- eshpux SXMODEL_LIB = $(LIBDIR)/libsxioipsl.a 

  • IOIPSL/trunk/src/calendar.f90

    • Property svn:keywords set to Id
    r4 r11  
    1 !$Header: /home/ioipsl/CVSROOT/IOIPSL/src/calendar.f90,v 2.7 2005/02/25 10:40:32 adm Exp $ 
     1!$Id$ 
    22!- 
    33MODULE calendar 

  • IOIPSL/trunk/src/def.prec

    • Property svn:keywords set to Id
    r4 r11  
    1 ! @author Jacques Bellier, Marie-Alice Foujols, Jan Polcher 
    2 ! @Version : $Revision: 2.1 $, $Date: 2005/06/24 09:57:17 $ 
    3 ! $Header: /home/ioipsl/CVSROOT/IOIPSL/src/def.prec,v 2.1 2005/06/24 09:57:17 adm Exp $ 
    4 ! 
     1! $Id$ 
    52MODULE defprec  
    63!!-------------------------------------------------------------------- 
    … …  
    1714  INTEGER,PARAMETER :: r_4=SELECTED_REAL_KIND(6,37) 
    1815  INTEGER,PARAMETER :: r_8=SELECTED_REAL_KIND(15,307) 
    19 !#-P-I4R4   INTEGER,PARAMETER :: i_std=i_4, r_std=r_4 
    20 !#-P-I4R8   INTEGER,PARAMETER :: i_std=i_4, r_std=r_8 
    21 !#-P-I8R8   INTEGER,PARAMETER :: i_std=i_8, r_std=r_8 
     16  INTEGER,PARAMETER :: i_std=i_?, r_std=r_? 
    2217!----------------- 
    2318END MODULE defprec 

  • IOIPSL/trunk/src/errioipsl.f90

    • Property svn:keywords set to Id
    r4 r11  
    1 !$Header: /home/ioipsl/CVSROOT/IOIPSL/src/errioipsl.f90,v 2.2 2005/02/22 10:14:14 adm Exp $ 
     1!$Id$ 
    22!- 
    33MODULE errioipsl 
    … …  
    77PRIVATE 
    88!- 
    9 PUBLIC :: ipslnlf, ipslerr, histerr, ipsldbg 
    10 !- 
    11   INTEGER :: n_l=6 
    12   LOGICAL :: ioipsl_debug=.FALSE. 
     9PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg 
     10!- 
     11  INTEGER :: n_l=6, ilv_cur=0, ilv_max=0 
     12  LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE. 
    1313!- 
    1414!=== 
    … …  
    1818!!-------------------------------------------------------------------- 
    1919!! The "ipslnlf" routine allows to know and modify 
    20 !! the current logical number for the messages, 
     20!! the current logical number for the messages. 
    2121!! 
    2222!! SUBROUTINE ipslnlf (new_number,old_number) 
    … …  
    7171!--------------------------------------------------------------------- 
    7272   IF ( (plev >= 1).AND.(plev <= 3) ) THEN 
     73     ilv_cur = plev 
     74     ilv_max = MAX(ilv_max,plev) 
    7375     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname) 
    7476     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3) 
    7577   ENDIF 
    76    IF (plev == 3) THEN 
     78   IF ( (plev == 3).AND.lact_mode) THEN 
    7779     STOP 'Fatal error from IOIPSL. See stdout for more details' 
    7880   ENDIF 
    7981!--------------------- 
    8082END SUBROUTINE ipslerr 
     83!=== 
     84SUBROUTINE ipslerr_act (new_mode,old_mode) 
     85!!-------------------------------------------------------------------- 
     86!! The "ipslerr_act" routine allows to know and modify 
     87!! the current "action mode" for the error messages, 
     88!! and reinitialize the error level values. 
     89!! 
     90!! SUBROUTINE ipslerr_act (new_mode,old_mode) 
     91!! 
     92!! Optional INPUT argument 
     93!! 
     94!! (I) new_mode : new error action mode 
     95!!                .TRUE.  -> STOP     in case of fatal error 
     96!!                .FALSE. -> CONTINUE in case of fatal error 
     97!! 
     98!! Optional OUTPUT argument 
     99!! 
     100!! (I) old_mode : current error action mode 
     101!!-------------------------------------------------------------------- 
     102  IMPLICIT NONE 
     103!- 
     104  LOGICAL,OPTIONAL,INTENT(IN)  :: new_mode 
     105  LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode 
     106!--------------------------------------------------------------------- 
     107  IF (PRESENT(old_mode)) THEN 
     108    old_mode = lact_mode 
     109  ENDIF 
     110  IF (PRESENT(new_mode)) THEN 
     111    lact_mode = new_mode 
     112  ENDIF 
     113  ilv_cur = 0 
     114  ilv_max = 0 
     115!------------------------- 
     116END SUBROUTINE ipslerr_act 
     117!=== 
     118SUBROUTINE ipslerr_inq (current_level,maximum_level) 
     119!!-------------------------------------------------------------------- 
     120!! The "ipslerr_inq" routine allows to know 
     121!! the current level of the error messages 
     122!! and the maximum level encountered since the 
     123!! last call to "ipslerr_act". 
     124!! 
     125!! SUBROUTINE ipslerr_inq (current_level,maximum_level) 
     126!! 
     127!! Optional OUTPUT argument 
     128!! 
     129!! (I) current_level : current error level 
     130!! (I) maximum_level : maximum error level 
     131!!-------------------------------------------------------------------- 
     132  IMPLICIT NONE 
     133!- 
     134  INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level 
     135!--------------------------------------------------------------------- 
     136  IF (PRESENT(current_level)) THEN 
     137    current_level = ilv_cur 
     138  ENDIF 
     139  IF (PRESENT(maximum_level)) THEN 
     140    maximum_level = ilv_max 
     141  ENDIF 
     142!------------------------- 
     143END SUBROUTINE ipslerr_inq 
    81144!=== 
    82145SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3) 

  • IOIPSL/trunk/src/flincom.f90

    • Property svn:keywords set to Id
    r4 r11  
    1 !$Header: /home/ioipsl/CVSROOT/IOIPSL/src/flincom.f90,v 2.2 2006/03/07 09:21:51 adm Exp $ 
     1!$Id$ 
    22!- 
    33MODULE flincom 

  • IOIPSL/trunk/src/getincom.f90

    • Property svn:keywords set to Id
    r4 r11  
    1 !$Header: /home/ioipsl/CVSROOT/IOIPSL/src/getincom.f90,v 2.1 2006/04/05 16:18:43 adm Exp $ 
     1!$Id$ 
    22!- 
    33MODULE getincom 
    44!--------------------------------------------------------------------- 
    5   USE stringop, & 
    6  &   ONLY : findpos,nocomma,cmpblank,strlowercase,gensig,find_sig 
    7 !- 
    8   IMPLICIT NONE 
    9 !- 
    10   PRIVATE 
    11   PUBLIC :: getin, getin_dump 
    12 !- 
    13   INTERFACE getin 
    14     MODULE PROCEDURE getinrs, getinr1d, getinr2d, & 
    15  &                   getinis, getini1d, getini2d, & 
    16  &                   getincs, getinc1d, getinc2d, & 
    17  &                   getinls, getinl1d, getinl2d 
    18   END INTERFACE 
     5USE errioipsl, ONLY : ipslerr 
     6USE stringop, & 
     7 &   ONLY : nocomma,cmpblank,strlowercase,gensig,find_sig 
     8!- 
     9IMPLICIT NONE 
     10!- 
     11PRIVATE 
     12PUBLIC :: getin, getin_dump 
     13!- 
     14INTERFACE getin 
     15  MODULE PROCEDURE getinrs, getinr1d, getinr2d, & 
     16 &                 getinis, getini1d, getini2d, & 
     17 &                 getincs, getinc1d, getinc2d, & 
     18 &                 getinls, getinl1d, getinl2d 
     19END INTERFACE 
    1920!- 
    2021  INTEGER,PARAMETER :: max_files=100 
    … …  
    2223  INTEGER,SAVE      :: nbfiles 
    2324!- 
    24   INTEGER,PARAMETER :: max_lines=500 
     25  INTEGER,PARAMETER :: max_lines=500,l_n=30 
    2526  INTEGER,SAVE :: nb_lines 
    2627  CHARACTER(LEN=100),DIMENSION(max_lines),SAVE :: fichier 
    2728  INTEGER,DIMENSION(max_lines),SAVE :: targetsiglist,fromfile,compline 
    28   CHARACTER(LEN=30),DIMENSION(max_lines),SAVE  :: targetlist 
     29  CHARACTER(LEN=l_n),DIMENSION(max_lines),SAVE  :: targetlist 
     30!- 
     31  INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15 
     32  CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)' 
    2933!- 
    3034! The data base of parameters 
    3135!- 
    3236  INTEGER,PARAMETER :: memslabs=200 
    33   INTEGER,PARAMETER :: compress_lim = 20 
     37  INTEGER,PARAMETER :: compress_lim=20 
    3438!- 
    3539  INTEGER,SAVE :: nb_keys=0 
    3640  INTEGER,SAVE :: keymemsize=0 
    3741  INTEGER,SAVE,ALLOCATABLE :: keysig(:) 
    38   CHARACTER(LEN=30),SAVE,ALLOCATABLE :: keystr(:) 
     42  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE :: keystr(:) 
    3943!- 
    4044! keystatus definition 
    … …  
    4650!- 
    4751! keytype definition 
    48 ! keytype = 1 : Interger 
     52! keytype = 1 : Integer 
    4953! keytype = 2 : Real 
    5054! keytype = 3 : Character 
    5155! keytype = 4 : Logical 
    5256!- 
     57  INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4 
     58!- 
    5359  INTEGER,SAVE,ALLOCATABLE :: keytype(:) 
    5460!- 
    … …  
    6369  INTEGER,SAVE,ALLOCATABLE :: keymemlen(:) 
    6470!- 
    65   INTEGER,SAVE,ALLOCATABLE :: intmem(:) 
    66   INTEGER,SAVE             :: intmemsize=0, intmempos=0 
    67   REAL,SAVE,ALLOCATABLE :: realmem(:) 
    68   INTEGER,SAVE          :: realmemsize=0, realmempos=0 
    69   CHARACTER(LEN=100),SAVE,ALLOCATABLE :: charmem(:) 
    70   INTEGER,SAVE             :: charmemsize=0, charmempos=0 
    71   LOGICAL,SAVE,ALLOCATABLE :: logicmem(:) 
    72   INTEGER,SAVE             :: logicmemsize=0, logicmempos=0 
     71  INTEGER,SAVE,ALLOCATABLE :: i_mem(:) 
     72  INTEGER,SAVE             :: i_memsize=0, i_mempos=0 
     73  REAL,SAVE,ALLOCATABLE :: r_mem(:) 
     74  INTEGER,SAVE          :: r_memsize=0, r_mempos=0 
     75  CHARACTER(LEN=100),SAVE,ALLOCATABLE :: c_mem(:) 
     76  INTEGER,SAVE             :: c_memsize=0, c_mempos=0 
     77  LOGICAL,SAVE,ALLOCATABLE :: l_mem(:) 
     78  INTEGER,SAVE             :: l_memsize=0, l_mempos=0 
    7379!- 
    7480CONTAINS 
    7581!- 
    76 !=== REAL INTERFACES 
    77 !- 
    78 SUBROUTINE getinrs (TARGET,ret_val) 
    79 !--------------------------------------------------------------------- 
    80 !-  Get a real scalar. We first check if we find it 
    81 !-  in the database and if not we get it from the run.def 
    82 !- 
    83 !-  getinr1d and getinr2d are written on the same pattern 
    84 !--------------------------------------------------------------------- 
    85   IMPLICIT NONE 
    86 !- 
    87   CHARACTER(LEN=*) :: TARGET 
    88   REAL :: ret_val 
    89 !- 
    90   REAL,DIMENSION(1) :: tmp_ret_val 
    91   INTEGER :: target_sig, pos, status=0, fileorig 
     82!=== INTEGER INTERFACE 
     83!- 
     84SUBROUTINE getinis (target,ret_val) 
     85!--------------------------------------------------------------------- 
     86!- Get a interer scalar. We first check if we find it 
     87!- in the database and if not we get it from the run.def 
     88!- 
     89!- getini1d and getini2d are written on the same pattern 
     90!--------------------------------------------------------------------- 
     91  IMPLICIT NONE 
     92!- 
     93  CHARACTER(LEN=*) :: target 
     94  INTEGER :: ret_val 
     95!- 
     96  INTEGER,DIMENSION(1) :: tmp_ret_val 
     97  INTEGER :: target_sig,pos,status=0,fileorig 
    9298!--------------------------------------------------------------------- 
    9399!- 
    94100! Compute the signature of the target 
    95101!- 
    96   CALL gensig (TARGET,target_sig) 
     102  CALL gensig (target,target_sig) 
    97103!- 
    98104! Do we have this target in our database ? 
    … …  
    104110  IF (pos < 0) THEN 
    105111!-- Get the information out of the file 
    106     CALL getfilr (TARGET,status,fileorig,tmp_ret_val) 
     112    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val) 
    107113!-- Put the data into the database 
    108     CALL getdbwr (TARGET,target_sig,status,fileorig,1,tmp_ret_val) 
     114    CALL get_wdb & 
     115 &   (target,target_sig,status,fileorig,1,i_val=tmp_ret_val) 
    109116  ELSE 
    110117!-- Get the value out of the database 
    111     CALL getdbrr (pos,1,TARGET,tmp_ret_val) 
     118    CALL get_rdb (pos,1,target,i_val=tmp_ret_val) 
    112119  ENDIF 
    113120  ret_val = tmp_ret_val(1) 
    114121!--------------------- 
    115 END SUBROUTINE getinrs 
    116 !- 
     122END SUBROUTINE getinis 
    117123!=== 
    118 !- 
    119 SUBROUTINE getinr1d (TARGET,ret_val) 
    120 !--------------------------------------------------------------------- 
    121 !- See getinrs for details. It is the same thing but for a vector 
    122 !--------------------------------------------------------------------- 
    123   IMPLICIT NONE 
    124 !- 
    125   CHARACTER(LEN=*) :: TARGET 
    126   REAL,DIMENSION(:) :: ret_val 
    127 !- 
    128   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
     124SUBROUTINE getini1d (target,ret_val) 
     125!--------------------------------------------------------------------- 
     126!- See getinis for details. It is the same thing but for a vector 
     127!--------------------------------------------------------------------- 
     128  IMPLICIT NONE 
     129!- 
     130  CHARACTER(LEN=*) :: target 
     131  INTEGER,DIMENSION(:) :: ret_val 
     132!- 
     133  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
    129134  INTEGER,SAVE :: tmp_ret_size = 0 
    130   INTEGER :: target_sig, pos, size_of_in, status=0, fileorig 
     135  INTEGER :: target_sig,pos,size_of_in,status=0,fileorig 
    131136!--------------------------------------------------------------------- 
    132137!- 
    133138! Compute the signature of the target 
    134139!- 
    135   CALL gensig (TARGET,target_sig) 
     140  CALL gensig (target,target_sig) 
    136141!- 
    137142! Do we have this target in our database ? 
    … …  
    150155!- 
    151156  IF (pos < 0) THEN 
    152 !-- Ge the information out of the file 
    153     CALL getfilr (TARGET,status,fileorig,tmp_ret_val) 
     157!-- Get the information out of the file 
     158    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val) 
    154159!-- Put the data into the database 
    155     CALL getdbwr & 
    156  &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
     160    CALL get_wdb & 
     161 &   (target,target_sig,status,fileorig,size_of_in,i_val=tmp_ret_val) 
    157162  ELSE 
    158163!-- Get the value out of the database 
    159     CALL getdbrr (pos,size_of_in,TARGET,tmp_ret_val) 
     164    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val) 
    160165  ENDIF 
    161166  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) 
    162167!---------------------- 
    163 END SUBROUTINE getinr1d 
    164 !- 
     168END SUBROUTINE getini1d 
    165169!=== 
    166 !- 
    167 SUBROUTINE getinr2d (TARGET,ret_val) 
    168 !--------------------------------------------------------------------- 
    169 !- See getinrs for details. It is the same thing but for a matrix 
    170 !--------------------------------------------------------------------- 
    171   IMPLICIT NONE 
    172 !- 
    173   CHARACTER(LEN=*) :: TARGET 
    174   REAL,DIMENSION(:,:) :: ret_val 
    175 !- 
    176   REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
     170SUBROUTINE getini2d (target,ret_val) 
     171!--------------------------------------------------------------------- 
     172!- See getinis for details. It is the same thing but for a matrix 
     173!--------------------------------------------------------------------- 
     174  IMPLICIT NONE 
     175!- 
     176  CHARACTER(LEN=*) :: target 
     177  INTEGER,DIMENSION(:,:) :: ret_val 
     178!- 
     179  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
    177180  INTEGER,SAVE :: tmp_ret_size = 0 
    178181  INTEGER :: target_sig,pos,size_of_in,size_1,size_2,status=0,fileorig 
    179   INTEGER :: jl, jj, ji 
     182  INTEGER :: jl,jj,ji 
    180183!--------------------------------------------------------------------- 
    181184!- 
    182185! Compute the signature of the target 
    183186!- 
    184   CALL gensig (TARGET,target_sig) 
     187  CALL gensig (target,target_sig) 
    185188!- 
    186189! Do we have this target in our database ? 
    … …  
    208211!- 
    209212  IF (pos < 0) THEN 
    210 !-- Ge the information out of the file 
    211     CALL getfilr (TARGET,status,fileorig,tmp_ret_val) 
     213!-- Get the information out of the file 
     214    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val) 
    212215!-- Put the data into the database 
    213     CALL getdbwr & 
    214  &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
     216    CALL get_wdb & 
     217 &   (target,target_sig,status,fileorig,size_of_in,i_val=tmp_ret_val) 
    215218  ELSE 
    216219!-- Get the value out of the database 
    217     CALL getdbrr (pos,size_of_in,TARGET,tmp_ret_val) 
     220    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val) 
     221  ENDIF 
     222!- 
     223  jl=0 
     224  DO jj=1,size_2 
     225    DO ji=1,size_1 
     226      jl=jl+1 
     227      ret_val(ji,jj) = tmp_ret_val(jl) 
     228    ENDDO 
     229  ENDDO 
     230!---------------------- 
     231END SUBROUTINE getini2d 
     232!- 
     233!=== REAL INTERFACE 
     234!- 
     235SUBROUTINE getinrs (target,ret_val) 
     236!--------------------------------------------------------------------- 
     237!-  Get a real scalar. We first check if we find it 
     238!-  in the database and if not we get it from the run.def 
     239!- 
     240!-  getinr1d and getinr2d are written on the same pattern 
     241!--------------------------------------------------------------------- 
     242  IMPLICIT NONE 
     243!- 
     244  CHARACTER(LEN=*) :: target 
     245  REAL :: ret_val 
     246!- 
     247  REAL,DIMENSION(1) :: tmp_ret_val 
     248  INTEGER :: target_sig,pos,status=0,fileorig 
     249!--------------------------------------------------------------------- 
     250!- 
     251! Compute the signature of the target 
     252!- 
     253  CALL gensig (target,target_sig) 
     254!- 
     255! Do we have this target in our database ? 
     256!- 
     257  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos) 
     258!- 
     259  tmp_ret_val(1) = ret_val 
     260!- 
     261  IF (pos < 0) THEN 
     262!-- Get the information out of the file 
     263    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val) 
     264!-- Put the data into the database 
     265    CALL get_wdb & 
     266 &   (target,target_sig,status,fileorig,1,r_val=tmp_ret_val) 
     267  ELSE 
     268!-- Get the value out of the database 
     269    CALL get_rdb (pos,1,target,r_val=tmp_ret_val) 
     270  ENDIF 
     271  ret_val = tmp_ret_val(1) 
     272!--------------------- 
     273END SUBROUTINE getinrs 
     274!=== 
     275SUBROUTINE getinr1d (target,ret_val) 
     276!--------------------------------------------------------------------- 
     277!- See getinrs for details. It is the same thing but for a vector 
     278!--------------------------------------------------------------------- 
     279  IMPLICIT NONE 
     280!- 
     281  CHARACTER(LEN=*) :: target 
     282  REAL,DIMENSION(:) :: ret_val 
     283!- 
     284  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
     285  INTEGER,SAVE :: tmp_ret_size = 0 
     286  INTEGER :: target_sig,pos,size_of_in,status=0,fileorig 
     287!--------------------------------------------------------------------- 
     288!- 
     289! Compute the signature of the target 
     290!- 
     291  CALL gensig (target,target_sig) 
     292!- 
     293! Do we have this target in our database ? 
     294!- 
     295  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos) 
     296!- 
     297  size_of_in = SIZE(ret_val) 
     298  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN 
     299    ALLOCATE (tmp_ret_val(size_of_in)) 
     300  ELSE IF (size_of_in > tmp_ret_size) THEN 
     301    DEALLOCATE (tmp_ret_val) 
     302    ALLOCATE (tmp_ret_val(size_of_in)) 
     303    tmp_ret_size = size_of_in 
     304  ENDIF 
     305  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in) 
     306!- 
     307  IF (pos < 0) THEN 
     308!-- Get the information out of the file 
     309    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val) 
     310!-- Put the data into the database 
     311    CALL get_wdb & 
     312 &   (target,target_sig,status,fileorig,size_of_in,r_val=tmp_ret_val) 
     313  ELSE 
     314!-- Get the value out of the database 
     315    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val) 
     316  ENDIF 
     317  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) 
     318!---------------------- 
     319END SUBROUTINE getinr1d 
     320!=== 
     321SUBROUTINE getinr2d (target,ret_val) 
     322!--------------------------------------------------------------------- 
     323!- See getinrs for details. It is the same thing but for a matrix 
     324!--------------------------------------------------------------------- 
     325  IMPLICIT NONE 
     326!- 
     327  CHARACTER(LEN=*) :: target 
     328  REAL,DIMENSION(:,:) :: ret_val 
     329!- 
     330  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
     331  INTEGER,SAVE :: tmp_ret_size = 0 
     332  INTEGER :: target_sig,pos,size_of_in,size_1,size_2,status=0,fileorig 
     333  INTEGER :: jl,jj,ji 
     334!--------------------------------------------------------------------- 
     335!- 
     336! Compute the signature of the target 
     337!- 
     338  CALL gensig (target,target_sig) 
     339!- 
     340! Do we have this target in our database ? 
     341!- 
     342  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos) 
     343!- 
     344  size_of_in = SIZE(ret_val) 
     345  size_1 = SIZE(ret_val,1) 
     346  size_2 = SIZE(ret_val,2) 
     347  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN 
     348    ALLOCATE (tmp_ret_val(size_of_in)) 
     349  ELSE IF (size_of_in > tmp_ret_size) THEN 
     350    DEALLOCATE (tmp_ret_val) 
     351    ALLOCATE (tmp_ret_val(size_of_in)) 
     352    tmp_ret_size = size_of_in 
     353  ENDIF 
     354!- 
     355  jl=0 
     356  DO jj=1,size_2 
     357    DO ji=1,size_1 
     358      jl=jl+1 
     359      tmp_ret_val(jl) = ret_val(ji,jj) 
     360    ENDDO 
     361  ENDDO 
     362!- 
     363  IF (pos < 0) THEN 
     364!-- Get the information out of the file 
     365    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val) 
     366!-- Put the data into the database 
     367    CALL get_wdb & 
     368 &   (target,target_sig,status,fileorig,size_of_in,r_val=tmp_ret_val) 
     369  ELSE 
     370!-- Get the value out of the database 
     371    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val) 
    218372  ENDIF 
    219373!- 
    … …  
    228382END SUBROUTINE getinr2d 
    229383!- 
    230 !=== 
    231 !- 
    232 SUBROUTINE getfilr (TARGET,status,fileorig,ret_val) 
    233 !--------------------------------------------------------------------- 
    234 !- Subroutine that will extract from the file the values 
    235 !- attributed to the keyword target 
    236 !- 
    237 !- REALS 
    238 !- ----- 
    239 !- 
    240 !- target   : in  : CHARACTER(LEN=*)  target for which we will 
    241 !-                                    look in the file 
    242 !- status   : out : INTEGER tells us from where we obtained the data 
    243 !- fileorig : out : The index of the file from which the key comes 
    244 !- ret_val  : out : REAL(nb_to_ret) values read 
    245 !--------------------------------------------------------------------- 
    246   IMPLICIT NONE 
    247 !- 
    248   CHARACTER(LEN=*) :: TARGET 
    249   INTEGER :: status, fileorig 
    250   REAL,DIMENSION(:) :: ret_val 
    251 !- 
    252   INTEGER :: nb_to_ret 
    253   INTEGER :: it, pos, len_str, epos, ppos, int_tmp, status_cnt 
    254   CHARACTER(LEN=3)  :: cnt, tl, dl 
    255   CHARACTER(LEN=10) :: fmt 
    256   CHARACTER(LEN=30) :: full_target 
    257   CHARACTER(LEN=80) :: str_READ, str_READ_lower, str_tmp 
    258   INTEGER :: full_target_sig 
    259   REAL :: compvalue 
    260 !- 
    261   INTEGER,SAVE :: max_len = 0 
    262   LOGICAL,SAVE,ALLOCATABLE :: found(:) 
    263   LOGICAL,SAVE :: def_beha 
    264   LOGICAL :: compressed = .FALSE. 
    265 !--------------------------------------------------------------------- 
    266   nb_to_ret = SIZE(ret_val) 
    267   CALL getin_read 
    268 !- 
    269 ! Get the variables and memory we need 
    270 !- 
    271   IF (max_len == 0) THEN 
    272     ALLOCATE(found(nb_to_ret)) 
    273     max_len = nb_to_ret 
    274   ENDIF 
    275   IF (max_len < nb_to_ret) THEN 
    276     DEALLOCATE(found) 
    277     ALLOCATE(found(nb_to_ret)) 
    278     max_len = nb_to_ret 
    279   ENDIF 
    280   found(:) = .FALSE. 
    281 !- 
    282 ! See what we find in the files read 
    283 !- 
    284   DO it=1,nb_to_ret 
    285 !--- 
    286 !- 
    287 !-- First try the target as it is 
    288 !--- 
    289     full_target = TARGET(1:len_TRIM(target)) 
    290     CALL gensig (full_target,full_target_sig) 
    291     CALL find_sig (nb_lines,targetlist,full_target, & 
    292  &                 targetsiglist,full_target_sig,pos) 
    293 !--- 
    294 !-- Another try 
    295 !--- 
    296     IF (pos < 0) THEN 
    297       WRITE(cnt,'(I3.3)') it 
    298       full_target = TARGET(1:len_TRIM(target))//'__'//cnt 
    299       CALL gensig (full_target,full_target_sig) 
    300       CALL find_sig (nb_lines,targetlist,full_target, & 
    301  &                   targetsiglist,full_target_sig,pos) 
    302     ENDIF 
    303 !--- 
    304 !-- A priori we dont know from which file the target could come. 
    305 !-- Thus by default we attribute it to the first file : 
    306 !--- 
    307     fileorig = 1 
    308 !-- 
    309     IF (pos > 0) THEN 
    310 !---- 
    311       found(it) = .TRUE. 
    312       fileorig = fromfile(pos) 
    313 !----- 
    314 !---- DECODE 
    315 !----- 
    316       str_READ = TRIM(ADJUSTL(fichier(pos))) 
    317       str_READ_lower = str_READ 
    318       CALL strlowercase (str_READ_lower) 
    319 !---- 
    320       IF (    (     (INDEX(str_READ_lower,'def') == 1)     & 
    321  &             .AND.(LEN_TRIM(str_READ_lower) == 3)   )    & 
    322  &        .OR.(     (INDEX(str_READ_lower,'default') == 1) & 
    323  &             .AND.(LEN_TRIM(str_READ_lower) == 7)   )   ) THEN 
    324         def_beha = .TRUE. 
    325       ELSE 
    326         def_beha = .FALSE. 
    327         len_str = LEN_TRIM(str_READ) 
    328         epos = INDEX(str_READ,'e') 
    329         ppos = INDEX(str_READ,'.') 
    330 !------ 
    331         IF (epos > 0) THEN 
    332           WRITE(tl,'(I3.3)') len_str 
    333           WRITE(dl,'(I3.3)') epos-ppos-1 
    334           fmt='(e'//tl//'.'//dl//')' 
    335           READ(str_READ,fmt) ret_val(it) 
    336         ELSE IF (ppos > 0) THEN 
    337           WRITE(tl,'(I3.3)') len_str 
    338           WRITE(dl,'(I3.3)') len_str-ppos 
    339           fmt='(f'//tl//'.'//dl//')' 
    340           READ(str_READ,fmt) ret_val(it) 
    341         ELSE 
    342           WRITE(tl,'(I3.3)') len_str 
    343           fmt = '(I'//tl//')' 
    344           READ(str_READ,fmt) int_tmp 
    345           ret_val(it) = REAL(int_tmp) 
    346         ENDIF 
    347       ENDIF 
    348 !---- 
    349       targetsiglist(pos) = -1 
    350 !----- 
    351 !---- Is this the value of a compressed field ? 
    352 !----- 
    353       IF (compline(pos) > 0) THEN 
    354         IF (compline(pos) == nb_to_ret) THEN 
    355           compressed = .TRUE. 
    356           compvalue = ret_val(it) 
    357         ELSE 
    358           WRITE(*,*) 'WARNING from getfilr' 
    359           WRITE(*,*) 'For key ',TRIM(TARGET), & 
    360  & ' we have a compressed field but which does not have the right size.' 
    361           WRITE(*,*) 'We will try to fix that ' 
    362           compressed = .TRUE. 
    363           compvalue = ret_val(it) 
    364         ENDIF 
    365       ENDIF 
    366     ELSE 
    367       found(it) = .FALSE. 
    368     ENDIF 
    369   ENDDO 
    370 !-- 
    371 ! If this is a compressed field then we will uncompress it 
    372 !-- 
    373   IF (compressed) THEN 
    374     DO it=1,nb_to_ret 
    375       IF (.NOT. found(it)) THEN 
    376         ret_val(it) = compvalue 
    377         found(it) = .TRUE. 
    378       ENDIF 
    379     ENDDO 
    380   ENDIF 
    381 !- 
    382 ! Now we get the status for what we found 
    383 !- 
    384   IF (def_beha) THEN 
    385     status = 2 
    386     WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(TARGET) 
     384!=== CHARACTER INTERFACE 
     385!- 
     386SUBROUTINE getincs (target,ret_val) 
     387!--------------------------------------------------------------------- 
     388!- Get a CHARACTER scalar. We first check if we find it 
     389!- in the database and if not we get it from the run.def 
     390!- 
     391!- getinc1d and getinc2d are written on the same pattern 
     392!--------------------------------------------------------------------- 
     393  IMPLICIT NONE 
     394!- 
     395  CHARACTER(LEN=*) :: target 
     396  CHARACTER(LEN=*) :: ret_val 
     397!- 
     398  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val 
     399  INTEGER :: target_sig,pos,status=0,fileorig 
     400!--------------------------------------------------------------------- 
     401!- 
     402! Compute the signature of the target 
     403!- 
     404  CALL gensig (target,target_sig) 
     405!- 
     406! Do we have this target in our database ? 
     407!- 
     408  CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos) 
     409!- 
     410  tmp_ret_val(1) = ret_val 
     411!- 
     412  IF (pos < 0) THEN 
     413!-- Get the information out of the file 
     414    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val) 
     415!-- Put the data into the database 
     416    CALL get_wdb & 
     417 &   (target,target_sig,status,fileorig,1,c_val=tmp_ret_val) 
    387418  ELSE 
    388     status_cnt = 0 
    389     DO it=1,nb_to_ret 
    390       IF (.NOT. found(it)) THEN 
    391         status_cnt = status_cnt+1 
    392         IF (nb_to_ret > 1) THEN 
    393           WRITE(str_tmp,'(a,"__",I3.3)') TRIM(TARGET),it 
    394         ELSE 
    395           str_tmp = TRIM(TARGET) 
    396         ENDIF 
    397         WRITE(*,*) 'USING DEFAULTS : ',TRIM(str_tmp),'=',ret_val(it) 
    398       ENDIF 
    399     ENDDO 
    400 !--- 
    401     IF (status_cnt == 0) THEN 
    402       status = 1 
    403     ELSE IF (status_cnt == nb_to_ret) THEN 
    404       status = 2 
    405     ELSE 
    406       status = 3 
    407     ENDIF 
    408   ENDIF 
    409 !--------------------- 
    410 END SUBROUTINE getfilr 
    411 !- 
    412 !=== INTEGER INTERFACES 
    413 !- 
    414 SUBROUTINE getinis (TARGET,ret_val) 
    415 !--------------------------------------------------------------------- 
    416 !- Get a interer scalar. We first check if we find it 
    417 !- in the database and if not we get it from the run.def 
    418 !- 
    419 !- getini1d and getini2d are written on the same pattern 
    420 !--------------------------------------------------------------------- 
    421   IMPLICIT NONE 
    422 !- 
    423   CHARACTER(LEN=*) :: TARGET 
    424   INTEGER :: ret_val 
    425 !- 
    426   INTEGER,DIMENSION(1) :: tmp_ret_val 
    427   INTEGER :: target_sig, pos, status=0, fileorig 
    428 !--------------------------------------------------------------------- 
    429 !- 
    430 ! Compute the signature of the target 
    431 !- 
    432   CALL gensig (TARGET,target_sig) 
    433 !- 
    434 ! Do we have this target in our database ? 
    435 !- 
    436   CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos) 
    437 !- 
    438   tmp_ret_val(1) = ret_val 
    439 !- 
    440   IF (pos < 0) THEN 
    441 !-- Ge the information out of the file 
    442     CALL getfili (TARGET,status,fileorig,tmp_ret_val) 
    443 !-- Put the data into the database 
    444     CALL getdbwi (TARGET,target_sig,status,fileorig,1,tmp_ret_val) 
    445     ELSE 
    446419!-- Get the value out of the database 
    447     CALL getdbri (pos,1,TARGET,tmp_ret_val) 
     420    CALL get_rdb (pos,1,target,c_val=tmp_ret_val) 
    448421  ENDIF 
    449422  ret_val = tmp_ret_val(1) 
    450423!--------------------- 
    451 END SUBROUTINE getinis 
    452 !- 
     424END SUBROUTINE getincs 
    453425!=== 
    454 !- 
    455 SUBROUTINE getini1d (TARGET,ret_val) 
    456 !--------------------------------------------------------------------- 
    457 !- See getinis for details. It is the same thing but for a vector 
    458 !--------------------------------------------------------------------- 
    459   IMPLICIT NONE 
    460 !- 
    461   CHARACTER(LEN=*) :: TARGET 
    462   INTEGER,DIMENSION(:) :: ret_val 
    463 !- 
    464   INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
     426SUBROUTINE getinc1d (target,ret_val) 
     427!--------------------------------------------------------------------- 
     428!- See getincs for details. It is the same thing but for a vector 
     429!--------------------------------------------------------------------- 
     430  IMPLICIT NONE 
     431!- 
     432  CHARACTER(LEN=*) :: target 
     433  CHARACTER(LEN=*),DIMENSION(:) :: ret_val 
     434!- 
     435  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
    465436  INTEGER,SAVE :: tmp_ret_size = 0 
    466   INTEGER :: target_sig, pos, size_of_in, status=0, fileorig 
     437  INTEGER :: target_sig,pos,size_of_in,status=0,fileorig 
    467438!--------------------------------------------------------------------- 
    468439!- 
    469440! Compute the signature of the target 
    470441!- 
    471   CALL gensig (TARGET,target_sig) 
     442  CALL gensig (target,target_sig) 
    472443!- 
    473444! Do we have this target in our database ? 
    … …  
    486457!- 
    487458  IF (pos < 0) THEN 
    488 !-- Ge the information out of the file 
    489     CALL getfili (TARGET,status,fileorig,tmp_ret_val) 
     459!-- Get the information out of the file 
     460    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val) 
    490461!-- Put the data into the database 
    491     CALL getdbwi & 
    492  &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
     462    CALL get_wdb & 
     463 &   (target,target_sig,status,fileorig,size_of_in,c_val=tmp_ret_val) 
    493464  ELSE 
    494465!-- Get the value out of the database 
    495     CALL getdbri (pos,size_of_in,TARGET,tmp_ret_val) 
     466    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val) 
    496467  ENDIF 
    497468  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) 
    498469!---------------------- 
    499 END SUBROUTINE getini1d 
    500 !- 
     470END SUBROUTINE getinc1d 
    501471!=== 
    502 !- 
    503 SUBROUTINE getini2d (TARGET,ret_val) 
    504 !--------------------------------------------------------------------- 
    505 !- See getinis for details. It is the same thing but for a matrix 
    506 !--------------------------------------------------------------------- 
    507   IMPLICIT NONE 
    508 !- 
    509   CHARACTER(LEN=*) :: TARGET 
    510   INTEGER,DIMENSION(:,:) :: ret_val 
    511 !- 
    512   INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
     472SUBROUTINE getinc2d (target,ret_val) 
     473!--------------------------------------------------------------------- 
     474!- See getincs for details. It is the same thing but for a matrix 
     475!--------------------------------------------------------------------- 
     476  IMPLICIT NONE 
     477!- 
     478  CHARACTER(LEN=*) :: target 
     479  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val 
     480!- 
     481  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
    513482  INTEGER,SAVE :: tmp_ret_size = 0 
    514483  INTEGER :: target_sig,pos,size_of_in,size_1,size_2,status=0,fileorig 
    515   INTEGER :: jl, jj, ji 
     484  INTEGER :: jl,jj,ji 
    516485!--------------------------------------------------------------------- 
    517486!- 
    518487! Compute the signature of the target 
    519488!- 
    520   CALL gensig (TARGET,target_sig) 
     489  CALL gensig (target,target_sig) 
    521490!- 
    522491! Do we have this target in our database ? 
    … …  
    544513!- 
    545514  IF (pos < 0) THEN 
    546 !-- Ge the information out of the file 
    547     CALL getfili (TARGET,status,fileorig,tmp_ret_val) 
     515!-- Get the information out of the file 
     516    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val) 
    548517!-- Put the data into the database 
    549     CALL getdbwi & 
    550  &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
     518    CALL get_wdb & 
     519 &   (target,target_sig,status,fileorig,size_of_in,c_val=tmp_ret_val) 
    551520  ELSE 
    552521!-- Get the value out of the database 
    553     CALL getdbri (pos,size_of_in,TARGET,tmp_ret_val) 
     522    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val) 
    554523  ENDIF 
    555524!- 
    … …  
    562531  ENDDO 
    563532!---------------------- 
    564 END SUBROUTINE getini2d 
    565 !- 
    566 !=== 
    567 !- 
    568 SUBROUTINE getfili (TARGET,status,fileorig,ret_val) 
    569 !--------------------------------------------------------------------- 
    570 !- Subroutine that will extract from the file the values 
    571 !- attributed to the keyword target 
    572 !- 
    573 !- INTEGER 
    574 !- ------- 
    575 !- 
    576 !- target   : in  : CHARACTER(LEN=*)  target for which we will 
    577 !-                                    look in the file 
    578 !- status   : out : INTEGER tells us from where we obtained the data 
    579 !- fileorig : out : The index of the file from which the key comes 
    580 !- ret_val  : out : INTEGER(nb_to_ret) values read 
    581 !--------------------------------------------------------------------- 
    582   IMPLICIT NONE 
    583 !- 
    584   CHARACTER(LEN=*) :: TARGET 
    585   INTEGER :: status, fileorig 
    586   INTEGER :: ret_val(:) 
    587 !- 
    588   INTEGER :: nb_to_ret 
    589   INTEGER :: it, pos, len_str, status_cnt 
    590   CHARACTER(LEN=3)  :: cnt, chlen 
    591   CHARACTER(LEN=10) ::  fmt 
    592   CHARACTER(LEN=30) :: full_target 
    593   CHARACTER(LEN=80) :: str_READ, str_READ_lower, str_tmp 
    594   INTEGER :: full_target_sig 
    595   INTEGER :: compvalue 
    596 !- 
    597   INTEGER,SAVE :: max_len = 0 
    598   LOGICAL,SAVE,ALLOCATABLE :: found(:) 
    599   LOGICAL,SAVE :: def_beha 
    600   LOGICAL :: compressed = .FALSE. 
    601 !--------------------------------------------------------------------- 
    602   nb_to_ret = SIZE(ret_val) 
    603   CALL getin_read 
    604 !- 
    605 ! Get the variables and memory we need 
    606 !- 
    607   IF (max_len == 0) THEN 
    608     ALLOCATE(found(nb_to_ret)) 
    609     max_len = nb_to_ret 
    610   ENDIF 
    611   IF (max_len < nb_to_ret) THEN 
    612     DEALLOCATE(found) 
    613     ALLOCATE(found(nb_to_ret)) 
    614     max_len = nb_to_ret 
    615   ENDIF 
    616   found(:) = .FALSE. 
    617 !- 
    618 ! See what we find in the files read 
    619 !- 
    620   DO it=1,nb_to_ret 
    621 !--- 
    622 !-- First try the target as it is 
    623 !--- 
    624     full_target = TARGET(1:len_TRIM(target)) 
    625     CALL gensig (full_target,full_target_sig) 
    626     CALL find_sig (nb_lines,targetlist,full_target, & 
    627  &                 targetsiglist,full_target_sig,pos) 
    628 !--- 
    629 !-- Another try 
    630 !--- 
    631     IF (pos < 0) THEN 
    632       WRITE(cnt,'(I3.3)') it 
    633       full_target = TARGET(1:len_TRIM(target))//'__'//cnt 
    634       CALL gensig (full_target,full_target_sig) 
    635       CALL find_sig (nb_lines,targetlist,full_target, & 
    636  &                   targetsiglist,full_target_sig,pos) 
    637     ENDIF 
    638 !--- 
    639 !-- A priori we dont know from which file the target could come. 
    640 !-- Thus by default we attribute it to the first file : 
    641 !--- 
    642     fileorig = 1 
    643 !- 
    644     IF (pos > 0) THEN 
    645 !----- 
    646       found(it) = .TRUE. 
    647       fileorig = fromfile(pos) 
    648 !----- 
    649 !---- DECODE 
    650 !---- 
    651       str_READ = TRIM(ADJUSTL(fichier(pos))) 
    652       str_READ_lower = str_READ 
    653       CALL strlowercase (str_READ_lower) 
    654 !----- 
    655       IF (    (     (INDEX(str_READ_lower,'def') == 1)     & 
    656  &             .AND.(LEN_TRIM(str_READ_lower) == 3)   )    & 
    657  &        .OR.(     (INDEX(str_READ_lower,'default') == 1) & 
    658  &             .AND.(LEN_TRIM(str_READ_lower) == 7)   )   ) THEN 
    659         def_beha = .TRUE. 
    660       ELSE 
    661         def_beha = .FALSE. 
    662         len_str = LEN_TRIM(str_READ) 
    663         WRITE(chlen,'(I3.3)') len_str 
    664         fmt = '(I'//chlen//')' 
    665         READ(str_READ,fmt) ret_val(it) 
    666       ENDIF 
    667 !----- 
    668       targetsiglist(pos) = -1 
    669 !----- 
    670 !---- Is this the value of a compressed field ? 
    671 !----- 
    672       IF (compline(pos) > 0) THEN 
    673         IF (compline(pos) == nb_to_ret) THEN 
    674           compressed = .TRUE. 
    675           compvalue = ret_val(it) 
    676         ELSE 
    677           WRITE(*,*) 'WARNING from getfilr' 
    678           WRITE(*,*) 'For key ',TRIM(TARGET), & 
    679  & ' we have a compressed field but which does not have the right size.' 
    680           WRITE(*,*) 'We will try to fix that ' 
    681           compressed = .TRUE. 
    682           compvalue = ret_val(it) 
    683         ENDIF 
    684       ENDIF 
    685     ELSE 
    686       found(it) = .FALSE. 
    687     ENDIF 
    688   ENDDO 
    689 !- 
    690 ! If this is a compressed field then we will uncompress it 
    691 !- 
    692   IF (compressed) THEN 
    693     DO it=1,nb_to_ret 
    694       IF (.NOT. found(it)) THEN 
    695         ret_val(it) = compvalue 
    696         found(it) = .TRUE. 
    697       ENDIF 
    698     ENDDO 
    699   ENDIF 
    700 !- 
    701 ! Now we get the status for what we found 
    702 !- 
    703   IF (def_beha) THEN 
    704     status = 2 
    705     WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(TARGET) 
    706   ELSE 
    707     status_cnt = 0 
    708     DO it=1,nb_to_ret 
    709       IF (.NOT. found(it)) THEN 
    710         status_cnt = status_cnt+1 
    711         IF (nb_to_ret > 1) THEN 
    712           WRITE(str_tmp,'(a,"__",I3.3)') TRIM(TARGET),it 
    713         ELSE 
    714           str_tmp = TRIM(TARGET) 
    715         ENDIF 
    716         WRITE(*,*) 'USING DEFAULTS : ',TRIM(str_tmp),'=',ret_val(it) 
    717       ENDIF 
    718     ENDDO 
    719 !--- 
    720     IF (status_cnt == 0) THEN 
    721       status = 1 
    722     ELSE IF (status_cnt == nb_to_ret) THEN 
    723       status = 2 
    724     ELSE 
    725       status = 3 
    726     ENDIF 
    727   ENDIF 
    728 !--------------------- 
    729 END SUBROUTINE getfili 
    730 !- 
    731 !=== CHARACTER INTERFACES 
    732 !- 
    733 SUBROUTINE getincs (TARGET,ret_val) 
    734 !--------------------------------------------------------------------- 
    735 !- Get a CHARACTER scalar. We first check if we find it 
     533END SUBROUTINE getinc2d 
     534!- 
     535!=== LOGICAL INTERFACE 
     536!- 
     537SUBROUTINE getinls (target,ret_val) 
     538!--------------------------------------------------------------------- 
     539!- Get a logical scalar. We first check if we find it 
    736540!- in the database and if not we get it from the run.def 
    737541!- 
    738 !- getinc1d and getinc2d are written on the same pattern 
    739 !--------------------------------------------------------------------- 
    740   IMPLICIT NONE 
    741 !- 
    742   CHARACTER(LEN=*) :: TARGET 
    743   CHARACTER(LEN=*) :: ret_val 
    744 !- 
    745   CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val 
    746   INTEGER :: target_sig, pos, status=0, fileorig 
     542!- getinl1d and getinl2d are written on the same pattern 
     543!--------------------------------------------------------------------- 
     544  IMPLICIT NONE 
     545!- 
     546  CHARACTER(LEN=*) :: target 
     547  LOGICAL :: ret_val 
     548!- 
     549  LOGICAL,DIMENSION(1) :: tmp_ret_val 
     550  INTEGER :: target_sig,pos,status=0,fileorig 
    747551!--------------------------------------------------------------------- 
    748552!- 
    749553! Compute the signature of the target 
    750554!- 
    751   CALL gensig (TARGET,target_sig) 
     555  CALL gensig (target,target_sig) 
    752556!- 
    753557! Do we have this target in our database ? 
    … …  
    758562!- 
    759563  IF (pos < 0) THEN 
    760 !-- Ge the information out of the file 
    761     CALL getfilc (TARGET,status,fileorig,tmp_ret_val) 
     564!-- Get the information out of the file 
     565    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val) 
    762566!-- Put the data into the database 
    763     CALL getdbwc (TARGET,target_sig,status,fileorig,1,tmp_ret_val) 
     567    CALL get_wdb & 
     568 &   (target,target_sig,status,fileorig,1,l_val=tmp_ret_val) 
    764569  ELSE 
    765570!-- Get the value out of the database 
    766     CALL getdbrc (pos,1,TARGET,tmp_ret_val) 
     571    CALL get_rdb (pos,1,target,l_val=tmp_ret_val) 
    767572  ENDIF 
    768573  ret_val = tmp_ret_val(1) 
    769574!--------------------- 
    770 END SUBROUTINE getincs 
    771 !- 
     575END SUBROUTINE getinls 
    772576!=== 
    773 !- 
    774 SUBROUTINE getinc1d (TARGET,ret_val) 
    775 !--------------------------------------------------------------------- 
    776 !- See getincs for details. It is the same thing but for a vector 
    777 !--------------------------------------------------------------------- 
    778   IMPLICIT NONE 
    779 !- 
    780   CHARACTER(LEN=*) :: TARGET 
    781   CHARACTER(LEN=*),DIMENSION(:) :: ret_val 
    782 !- 
    783   CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
     577SUBROUTINE getinl1d (target,ret_val) 
     578!--------------------------------------------------------------------- 
     579!- See getinls for details. It is the same thing but for a vector 
     580!--------------------------------------------------------------------- 
     581  IMPLICIT NONE 
     582!- 
     583  CHARACTER(LEN=*) :: target 
     584  LOGICAL,DIMENSION(:) :: ret_val 
     585!- 
     586  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
    784587  INTEGER,SAVE :: tmp_ret_size = 0 
    785   INTEGER :: target_sig, pos, size_of_in, status=0, fileorig 
     588  INTEGER :: target_sig,pos,size_of_in,status=0,fileorig 
    786589!--------------------------------------------------------------------- 
    787590!- 
    788591! Compute the signature of the target 
    789592!- 
    790   CALL gensig (TARGET,target_sig) 
     593  CALL gensig (target,target_sig) 
    791594!- 
    792595! Do we have this target in our database ? 
    … …  
    805608!- 
    806609  IF (pos < 0) THEN 
    807 !-- Ge the information out of the file 
    808     CALL getfilc (TARGET,status,fileorig,tmp_ret_val) 
     610!-- Get the information out of the file 
     611    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val) 
    809612!-- Put the data into the database 
    810     CALL getdbwc & 
    811  &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
     613    CALL get_wdb & 
     614 &   (target,target_sig,status,fileorig,size_of_in,l_val=tmp_ret_val) 
    812615  ELSE 
    813616!-- Get the value out of the database 
    814     CALL getdbrc (pos,size_of_in,TARGET,tmp_ret_val) 
     617    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val) 
    815618  ENDIF 
    816619  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) 
    817620!---------------------- 
    818 END SUBROUTINE getinc1d 
    819 !- 
     621END SUBROUTINE getinl1d 
    820622!=== 
    821 !- 
    822 SUBROUTINE getinc2d (TARGET,ret_val) 
    823 !--------------------------------------------------------------------- 
    824 !- See getincs for details. It is the same thing but for a matrix 
    825 !--------------------------------------------------------------------- 
    826   IMPLICIT NONE 
    827 !- 
    828   CHARACTER(LEN=*) :: TARGET 
    829   CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val 
    830 !- 
    831   CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
     623SUBROUTINE getinl2d (target,ret_val) 
     624!--------------------------------------------------------------------- 
     625!- See getinls for details. It is the same thing but for a matrix 
     626!--------------------------------------------------------------------- 
     627  IMPLICIT NONE 
     628!- 
     629  CHARACTER(LEN=*) :: target 
     630  LOGICAL,DIMENSION(:,:) :: ret_val 
     631!- 
     632  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
    832633  INTEGER,SAVE :: tmp_ret_size = 0 
    833634  INTEGER :: target_sig,pos,size_of_in,size_1,size_2,status=0,fileorig 
    … …  
    837638! Compute the signature of the target 
    838639!- 
    839   CALL gensig (TARGET,target_sig) 
     640  CALL gensig (target,target_sig) 
    840641!- 
    841642! Do we have this target in our database ? 
    … …  
    863664!- 
    864665  IF (pos < 0) THEN 
    865 !-- Ge the information out of the file 
    866     CALL getfilc (TARGET,status,fileorig,tmp_ret_val) 
     666!-- Get the information out of the file 
     667    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val) 
    867668!-- Put the data into the database 
    868     CALL getdbwc & 
    869  &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
     669    CALL get_wdb & 
     670 &   (target,target_sig,status,fileorig,size_of_in,l_val=tmp_ret_val) 
    870671  ELSE 
    871672!-- Get the value out of the database 
    872     CALL getdbrc (pos,size_of_in,TARGET,tmp_ret_val) 
    873   ENDIF 
    874 !- 
    875   jl=0 
    876   DO jj=1,size_2 
    877     DO ji=1,size_1 
    878       jl=jl+1 
    879       ret_val(ji,jj) = tmp_ret_val(jl) 
    880     ENDDO 
    881   ENDDO 
    882 !---------------------- 
    883 END SUBROUTINE getinc2d 
    884 !- 
    885 !=== 
    886 !- 
    887 SUBROUTINE getfilc (TARGET,status,fileorig,ret_val) 
    888 !--------------------------------------------------------------------- 
    889 !- Subroutine that will extract from the file the values 
    890 !- attributed to the keyword target 
    891 !- 
    892 !- CHARACTER 
    893 !- --------- 
    894 !- 
    895 !- target   : in  : CHARACTER(LEN=*)  target for which we will 
    896 !-                                    look in the file 
    897 !- status   : out : INTEGER tells us from where we obtained the data 
    898 !- fileorig : out : The index of the file from which the key comes 
    899 !- ret_val  : out : CHARACTER(nb_to_ret) values read 
    900 !--------------------------------------------------------------------- 
    901   IMPLICIT NONE 
    902 !- 
    903 !- 
    904   CHARACTER(LEN=*) :: TARGET 
    905   INTEGER :: status, fileorig 
    906   CHARACTER(LEN=*),DIMENSION(:) :: ret_val 
    907 !- 
    908   INTEGER :: nb_to_ret 
    909   INTEGER :: it, pos, len_str, status_cnt 
    910   CHARACTER(LEN=3)  :: cnt 
    911   CHARACTER(LEN=30) :: full_target 
    912   CHARACTER(LEN=80) :: str_READ, str_READ_lower, str_tmp 
    913   INTEGER :: full_target_sig 
    914 !- 
    915   INTEGER,SAVE :: max_len = 0 
    916   LOGICAL,DIMENSION(:),SAVE,ALLOCATABLE :: found 
    917   LOGICAL,SAVE :: def_beha 
    918 !--------------------------------------------------------------------- 
    919   nb_to_ret = SIZE(ret_val) 
    920   CALL getin_read 
    921 !- 
    922 ! Get the variables and memory we need 
    923 !- 
    924   IF (max_len == 0) THEN 
    925     ALLOCATE(found(nb_to_ret)) 
    926     max_len = nb_to_ret 
    927   ENDIF 
    928   IF (max_len < nb_to_ret) THEN 
    929     DEALLOCATE(found) 
    930     ALLOCATE(found(nb_to_ret)) 
    931     max_len = nb_to_ret 
    932   ENDIF 
    933   found(:) = .FALSE. 
    934 !- 
    935 ! See what we find in the files read 
    936 !- 
    937   DO it=1,nb_to_ret 
    938 !--- 
    939 !-- First try the target as it is 
    940     full_target = TARGET(1:len_TRIM(target)) 
    941     CALL gensig (full_target,full_target_sig) 
    942     CALL find_sig (nb_lines,targetlist,full_target, & 
    943  &                 targetsiglist,full_target_sig,pos) 
    944 !--- 
    945 !-- Another try 
    946 !--- 
    947     IF (pos < 0) THEN 
    948       WRITE(cnt,'(I3.3)') it 
    949       full_target = TARGET(1:len_TRIM(target))//'__'//cnt 
    950       CALL gensig (full_target,full_target_sig) 
    951       CALL find_sig (nb_lines,targetlist,full_target, & 
    952  &                   targetsiglist,full_target_sig,pos) 
    953     ENDIF 
    954 !--- 
    955 !-- A priori we dont know from which file the target could come. 
    956 !-- Thus by default we attribute it to the first file : 
    957 !--- 
    958     fileorig = 1 
    959 !--- 
    960     IF (pos > 0) THEN 
    961 !----- 
    962       found(it) = .TRUE. 
    963       fileorig = fromfile(pos) 
    964 !----- 
    965 !---- DECODE 
    966 !----- 
    967       str_READ = TRIM(ADJUSTL(fichier(pos))) 
    968       str_READ_lower = str_READ 
    969       CALL strlowercase (str_READ_lower) 
    970 !----- 
    971       IF (    (     (INDEX(str_READ_lower,'def') == 1)     & 
    972  &             .AND.(LEN_TRIM(str_READ_lower) == 3)   )    & 
    973  &        .OR.(     (INDEX(str_READ_lower,'default') == 1) & 
    974  &             .AND.(LEN_TRIM(str_READ_lower) == 7)   )   ) THEN 
    975         def_beha = .TRUE. 
    976       ELSE 
    977         def_beha = .FALSE. 
    978         len_str = LEN_TRIM(str_READ) 
    979         ret_val(it) = str_READ(1:len_str) 
    980       ENDIF 
    981 !----- 
    982       targetsiglist(pos) = -1 
    983 !----- 
    984     ELSE 
    985       found(it) = .FALSE. 
    986     ENDIF 
    987   ENDDO 
    988 !- 
    989 ! Now we get the status for what we found 
    990 !- 
    991   IF (def_beha) THEN 
    992     status = 2 
    993     WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(TARGET) 
    994   ELSE 
    995     status_cnt = 0 
    996     DO it=1,nb_to_ret 
    997       IF (.NOT. found(it)) THEN 
    998         status_cnt = status_cnt+1 
    999         IF (nb_to_ret > 1) THEN 
    1000           WRITE(str_tmp,'(a,"__",I3.3)') TRIM(TARGET),it 
    1001         ELSE 
    1002           str_tmp = TARGET(1:len_TRIM(target)) 
    1003         ENDIF 
    1004         WRITE(*,*) 'USING DEFAULTS : ',TRIM(str_tmp),'=',ret_val(it) 
    1005       ENDIF 
    1006     ENDDO 
    1007 !- 
    1008     IF (status_cnt == 0) THEN 
    1009       status = 1 
    1010     ELSE IF (status_cnt == nb_to_ret) THEN 
    1011       status = 2 
    1012     ELSE 
    1013       status = 3 
    1014     ENDIF 
    1015   ENDIF 
    1016 !--------------------- 
    1017 END SUBROUTINE getfilc 
    1018 !- 
    1019 !=== LOGICAL INTERFACES 
    1020 !- 
    1021 SUBROUTINE getinls (TARGET,ret_val) 
    1022 !--------------------------------------------------------------------- 
    1023 !- Get a logical scalar. We first check if we find it 
    1024 !- in the database and if not we get it from the run.def 
    1025 !- 
    1026 !- getinl1d and getinl2d are written on the same pattern 
    1027 !--------------------------------------------------------------------- 
    1028   IMPLICIT NONE 
    1029 !- 
    1030   CHARACTER(LEN=*) :: TARGET 
    1031   LOGICAL :: ret_val 
    1032 !- 
    1033   LOGICAL,DIMENSION(1) :: tmp_ret_val 
    1034   INTEGER :: target_sig, pos, status=0, fileorig 
    1035 !--------------------------------------------------------------------- 
    1036 !- 
    1037 ! Compute the signature of the target 
    1038 !- 
    1039   CALL gensig (TARGET,target_sig) 
    1040 !- 
    1041 ! Do we have this target in our database ? 
    1042 !- 
    1043   CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos) 
    1044 !- 
    1045   tmp_ret_val(1) = ret_val 
    1046 !- 
    1047   IF (pos < 0) THEN 
    1048 !-- Ge the information out of the file 
    1049     CALL getfill (TARGET,status,fileorig,tmp_ret_val) 
    1050 !-- Put the data into the database 
    1051     CALL getdbwl (TARGET,target_sig,status,fileorig,1,tmp_ret_val) 
    1052   ELSE 
    1053 !-- Get the value out of the database 
    1054     CALL getdbrl (pos,1,TARGET,tmp_ret_val) 
    1055   ENDIF 
    1056   ret_val = tmp_ret_val(1) 
    1057 !--------------------- 
    1058 END SUBROUTINE getinls 
    1059 !- 
    1060 !=== 
    1061 !- 
    1062 SUBROUTINE getinl1d (TARGET,ret_val) 
    1063 !--------------------------------------------------------------------- 
    1064 !- See getinls for details. It is the same thing but for a vector 
    1065 !--------------------------------------------------------------------- 
    1066   IMPLICIT NONE 
    1067 !- 
    1068   CHARACTER(LEN=*) :: TARGET 
    1069   LOGICAL,DIMENSION(:) :: ret_val 
    1070 !- 
    1071   LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
    1072   INTEGER,SAVE :: tmp_ret_size = 0 
    1073   INTEGER :: target_sig, pos, size_of_in, status=0, fileorig 
    1074 !--------------------------------------------------------------------- 
    1075 !- 
    1076 ! Compute the signature of the target 
    1077 !- 
    1078   CALL gensig (TARGET,target_sig) 
    1079 !- 
    1080 ! Do we have this target in our database ? 
    1081 !- 
    1082   CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos) 
    1083 !- 
    1084   size_of_in = SIZE(ret_val) 
    1085   IF (.NOT.ALLOCATED(tmp_ret_val)) THEN 
    1086     ALLOCATE (tmp_ret_val(size_of_in)) 
    1087   ELSE IF (size_of_in > tmp_ret_size) THEN 
    1088     DEALLOCATE (tmp_ret_val) 
    1089     ALLOCATE (tmp_ret_val(size_of_in)) 
    1090     tmp_ret_size = size_of_in 
    1091   ENDIF 
    1092   tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in) 
    1093 !- 
    1094   IF (pos < 0) THEN 
    1095 !-- Ge the information out of the file 
    1096     CALL getfill (TARGET,status,fileorig,tmp_ret_val) 
    1097 !-- Put the data into the database 
    1098     CALL getdbwl & 
    1099  &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
    1100   ELSE 
    1101 !-- Get the value out of the database 
    1102     CALL getdbrl (pos,size_of_in,TARGET,tmp_ret_val) 
    1103   ENDIF 
    1104   ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) 
    1105 !---------------------- 
    1106 END SUBROUTINE getinl1d 
    1107 !- 
    1108 !=== 
    1109 !- 
    1110 SUBROUTINE getinl2d (TARGET,ret_val) 
    1111 !--------------------------------------------------------------------- 
    1112 !- See getinls for details. It is the same thing but for a matrix 
    1113 !--------------------------------------------------------------------- 
    1114   IMPLICIT NONE 
    1115 !- 
    1116   CHARACTER(LEN=*) :: TARGET 
    1117   LOGICAL,DIMENSION(:,:) :: ret_val 
    1118 !- 
    1119   LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val 
    1120   INTEGER,SAVE :: tmp_ret_size = 0 
    1121   INTEGER :: target_sig,pos,size_of_in,size_1,size_2,status=0,fileorig 
    1122   INTEGER :: jl,jj,ji 
    1123 !--------------------------------------------------------------------- 
    1124 !- 
    1125 ! Compute the signature of the target 
    1126 !- 
    1127   CALL gensig (TARGET,target_sig) 
    1128 !- 
    1129 ! Do we have this target in our database ? 
    1130 !- 
    1131   CALL find_sig (nb_keys,keystr,target,keysig,target_sig,pos) 
    1132 !- 
    1133   size_of_in = SIZE(ret_val) 
    1134   size_1 = SIZE(ret_val,1) 
    1135   size_2 = SIZE(ret_val,2) 
    1136   IF (.NOT.ALLOCATED(tmp_ret_val)) THEN 
    1137     ALLOCATE (tmp_ret_val(size_of_in)) 
    1138   ELSE IF (size_of_in > tmp_ret_size) THEN 
    1139     DEALLOCATE (tmp_ret_val) 
    1140     ALLOCATE (tmp_ret_val(size_of_in)) 
    1141     tmp_ret_size = size_of_in 
    1142   ENDIF 
    1143 !- 
    1144   jl=0 
    1145   DO jj=1,size_2 
    1146     DO ji=1,size_1 
    1147       jl=jl+1 
    1148       tmp_ret_val(jl) = ret_val(ji,jj) 
    1149     ENDDO 
    1150   ENDDO 
    1151 !- 
    1152   IF (pos < 0) THEN 
    1153 !-- Ge the information out of the file 
    1154     CALL getfill (TARGET,status,fileorig,tmp_ret_val) 
    1155 !-- Put the data into the database 
    1156     CALL getdbwl & 
    1157  &   (TARGET,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
    1158   ELSE 
    1159 !-- Get the value out of the database 
    1160     CALL getdbrl (pos,size_of_in,TARGET,tmp_ret_val) 
     673    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val) 
    1161674  ENDIF 
    1162675!- 
    … …  
    1171684END SUBROUTINE getinl2d 
    1172685!- 
    1173 !=== 
    1174 !- 
    1175 SUBROUTINE getfill (TARGET,status,fileorig,ret_val) 
     686!=== Generic file/database INTERFACE 
     687!- 
     688SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val) 
    1176689!--------------------------------------------------------------------- 
    1177690!- Subroutine that will extract from the file the values 
    1178691!- attributed to the keyword target 
    1179692!- 
    1180 !- LOGICAL 
    1181 !- ------- 
    1182 !- 
    1183 !- target   : in  : CHARACTER(LEN=*)  target for which we will 
    1184 !-                                    look in the file 
    1185 !- status   : out : INTEGER tells us from where we obtained the data 
    1186 !- fileorig : out : The index of the file from which the key comes 
    1187 !- ret_val  : out : LOGICAL(nb_to_ret) values read 
    1188 !--------------------------------------------------------------------- 
    1189   IMPLICIT NONE 
    1190 !- 
    1191   CHARACTER(LEN=*) :: TARGET 
    1192   INTEGER :: status, fileorig 
    1193   LOGICAL,DIMENSION(:) :: ret_val 
    1194 !- 
    1195   INTEGER :: nb_to_ret 
    1196   INTEGER :: it, pos, len_str, ipos_tr, ipos_fl, status_cnt 
    1197   CHARACTER(LEN=3)  :: cnt 
    1198   CHARACTER(LEN=30) :: full_target 
    1199   CHARACTER(LEN=80) :: str_READ, str_READ_lower, str_tmp 
     693!- (C) target    : target for which we will look in the file 
     694!- (I) status    : tells us from where we obtained the data 
     695!- (I) fileorig  : index of the file from which the key comes 
     696!- (I) i_val(:)  : INTEGER(nb_to_ret)   values 
     697!- (R) r_val(:)  : REAL(nb_to_ret)      values 
     698!- (L) l_val(:)  : LOGICAL(nb_to_ret)   values 
     699!- (C) c_val(:)  : CHARACTER(nb_to_ret) values 
     700!--------------------------------------------------------------------- 
     701  IMPLICIT NONE 
     702!- 
     703  CHARACTER(LEN=*) :: target 
     704  INTEGER,INTENT(OUT) :: status,fileorig 
     705  INTEGER,DIMENSION(:),OPTIONAL          :: i_val 
     706  REAL,DIMENSION(:),OPTIONAL             :: r_val 
     707  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val 
     708  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val 
     709!- 
     710  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err 
     711  CHARACTER(LEN=n_d_fmt)  :: cnt 
     712  CHARACTER(LEN=37) :: full_target 
     713  CHARACTER(LEN=80) :: str_READ,str_READ_lower 
     714  CHARACTER(LEN=9)  :: c_vtyp 
    1200715  INTEGER :: full_target_sig 
    1201 !- 
    1202   INTEGER,SAVE :: max_len = 0 
    1203   LOGICAL,DIMENSION(:),SAVE,ALLOCATABLE :: found 
    1204   LOGICAL,SAVE :: def_beha 
    1205 !--------------------------------------------------------------------- 
    1206   nb_to_ret = SIZE(ret_val) 
     716  LOGICAL,DIMENSION(:),ALLOCATABLE :: found 
     717  LOGICAL :: def_beha,compressed 
     718  CHARACTER(LEN=10) :: c_fmt 
     719  INTEGER :: i_cmpval 
     720  REAL    :: r_cmpval 
     721  INTEGER :: ipos_tr,ipos_fl 
     722!--------------------------------------------------------------------- 
     723!- 
     724! Get the type of the argument 
     725  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val) 
     726  SELECT CASE (k_typ) 
     727  CASE(k_i) 
     728    nb_to_ret = SIZE(i_val) 
     729  CASE(k_r) 
     730    nb_to_ret = SIZE(r_val) 
     731  CASE(k_c) 
     732    nb_to_ret = SIZE(c_val) 
     733  CASE(k_l) 
     734    nb_to_ret = SIZE(l_val) 
     735  CASE DEFAULT 
     736    CALL ipslerr (3,'get_fil', & 
     737 &   'Internal error','Unknown type of data',' ') 
     738  END SELECT 
     739!- 
     740! Read the file(s) 
    1207741  CALL getin_read 
    1208742!- 
    1209 ! Get the variables and memory we need 
    1210 !- 
    1211   IF (max_len == 0) THEN 
    1212     ALLOCATE(found(nb_to_ret)) 
    1213     max_len = nb_to_ret 
    1214   ENDIF 
    1215   IF (max_len < nb_to_ret) THEN 
    1216     DEALLOCATE(found) 
    1217     ALLOCATE(found(nb_to_ret)) 
    1218     max_len = nb_to_ret 
    1219   ENDIF 
     743! Allocate and initialize the memory we need 
     744  ALLOCATE(found(nb_to_ret)) 
    1220745  found(:) = .FALSE. 
    1221746!- 
    1222747! See what we find in the files read 
    1223 !- 
    1224748  DO it=1,nb_to_ret 
    1225749!--- 
    1226750!-- First try the target as it is 
    1227 !--- 
    1228     full_target = TARGET(1:len_TRIM(target)) 
     751    full_target = target 
    1229752    CALL gensig (full_target,full_target_sig) 
    1230753    CALL find_sig (nb_lines,targetlist,full_target, & 
    … …  
    1234757!--- 
    1235758    IF (pos < 0) THEN 
    1236       WRITE(cnt,'(I3.3)') it 
    1237       full_target = TARGET(1:len_TRIM(target))//'__'//cnt 
     759      WRITE(UNIT=cnt,FMT=c_i_fmt) it 
     760      full_target = TRIM(target)//'__'//cnt 
    1238761      CALL gensig (full_target,full_target_sig) 
    1239762      CALL find_sig (nb_lines,targetlist,full_target, & 
    … …  
    1241764    ENDIF 
    1242765!--- 
    1243 !-- A priori we dont know from which file the target could come. 
     766!-- We dont know from which file the target could come. 
    1244767!-- Thus by default we attribute it to the first file : 
    1245 !--- 
    1246768    fileorig = 1 
    1247769!--- 
    … …  
    1253775!---- DECODE 
    1254776!----- 
    1255       str_READ = TRIM(ADJUSTL(fichier(pos))) 
     777      str_READ = ADJUSTL(fichier(pos)) 
    1256778      str_READ_lower = str_READ 
    1257779      CALL strlowercase (str_READ_lower) 
    1258780!----- 
    1259       IF (    (     (INDEX(str_READ_lower,'def') == 1)     & 
    1260  &             .AND.(LEN_TRIM(str_READ_lower) == 3)   )    & 
    1261  &        .OR.(     (INDEX(str_READ_lower,'default') == 1) & 
    1262  &             .AND.(LEN_TRIM(str_READ_lower) == 7)   )   ) THEN 
     781      IF (    (TRIM(str_READ_lower) == 'def')     & 
     782 &        .OR.(TRIM(str_READ_lower) == 'default') ) THEN 
    1263783        def_beha = .TRUE. 
    1264784      ELSE 
    1265785        def_beha = .FALSE. 
    1266786        len_str = LEN_TRIM(str_READ) 
    1267         ipos_tr = -1 
    1268         ipos_fl = -1 
    1269 !------- 
    1270         ipos_tr = MAX(INDEX(str_READ,'tru'),INDEX(str_READ,'TRU'), & 
    1271  &                    INDEX(str_READ,'y'),INDEX(str_READ,'Y')) 
    1272         ipos_fl = MAX(INDEX(str_READ,'fal'),INDEX(str_READ,'FAL'), & 
    1273  &                    INDEX(str_READ,'n'),INDEX(str_READ,'N')) 
    1274 !------- 
    1275         IF (ipos_tr > 0) THEN 
    1276           ret_val(it) = .TRUE. 
    1277         ELSE IF (ipos_fl > 0) THEN 
    1278           ret_val(it) = .FALSE. 
    1279         ELSE 
    1280           WRITE(*,*) "ERROR : getfill : TARGET ", & 
    1281  &                   TRIM(TARGET)," is not of logical value" 
    1282           STOP 'getinl' 
     787        io_err = 0 
     788        SELECT CASE (k_typ) 
     789        CASE(k_i) 
     790          WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str 
     791          READ (UNIT=str_READ(1:len_str), & 
     792 &              FMT=c_fmt,IOSTAT=io_err) i_val(it) 
     793        CASE(k_r) 
     794          READ (UNIT=str_READ(1:len_str), & 
     795 &              FMT=*,IOSTAT=io_err) r_val(it) 
     796        CASE(k_c) 
     797          c_val(it) = str_READ(1:len_str) 
     798        CASE(k_l) 
     799          ipos_tr = -1 
     800          ipos_fl = -1 
     801          ipos_tr = MAX(INDEX(str_READ_lower,'tru'), & 
     802 &                      INDEX(str_READ_lower,'y')) 
     803          ipos_fl = MAX(INDEX(str_READ_lower,'fal'), & 
     804 &                      INDEX(str_READ_lower,'n')) 
     805          IF (ipos_tr > 0) THEN 
     806            l_val(it) = .TRUE. 
     807          ELSE IF (ipos_fl > 0) THEN 
     808            l_val(it) = .FALSE. 
     809          ELSE 
     810            io_err = 100 
     811          ENDIF 
     812        END SELECT 
     813        IF (io_err /= 0) THEN 
     814          CALL ipslerr (3,'get_fil', & 
     815 &         'Target '//TRIM(target), & 
     816 &         'is not of '//TRIM(c_vtyp)//' type',' ') 
    1283817        ENDIF 
    1284818      ENDIF 
    … …  
    1286820      targetsiglist(pos) = -1 
    1287821!----- 
     822      IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN 
     823!------- 
     824!------ Is this the value of a compressed field ? 
     825        compressed = (compline(pos) > 0) 
     826        IF (compressed) THEN 
     827          IF (compline(pos) /= nb_to_ret) THEN 
     828            CALL ipslerr (2,'get_fil', & 
     829 &           'For key '//TRIM(target)//' we have a compressed field', & 
     830 &           'which does not have the right size.', & 
     831 &           'We will try to fix that.') 
     832          ENDIF 
     833          IF      (k_typ == k_i) THEN 
     834            i_cmpval = i_val(it) 
     835          ELSE IF (k_typ == k_r) THEN 
     836            r_cmpval = r_val(it) 
     837          ENDIF 
     838        ENDIF 
     839      ENDIF 
    1288840    ELSE 
    1289 !- 
    1290841      found(it) = .FALSE. 
    1291 !- 
    1292     ENDIF 
    1293 !- 
     842      def_beha = .FALSE. 
     843      compressed = .FALSE. 
     844    ENDIF 
    1294845  ENDDO 
    1295846!- 
    1296 ! Now we get the status for what we found 
    1297 !- 
     847  IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN 
     848!--- 
     849!-- If this is a compressed field then we will uncompress it 
     850    IF (compressed) THEN 
     851      DO it=1,nb_to_ret 
     852        IF (.NOT.found(it)) THEN 
     853          IF      (k_typ == k_i) THEN 
     854            i_val(it) = i_cmpval 
     855          ELSE IF (k_typ == k_r) THEN 
     856          ENDIF 
     857          found(it) = .TRUE. 
     858        ENDIF 
     859      ENDDO 
     860    ENDIF 
     861  ENDIF 
     862!- 
     863! Now we set the status for what we found 
    1298864  IF (def_beha) THEN 
    1299865    status = 2 
    1300     WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(TARGET) 
     866    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target) 
    1301867  ELSE 
    1302868    status_cnt = 0 
    1303869    DO it=1,nb_to_ret 
    1304       IF (.NOT. found(it)) THEN 
     870      IF (.NOT.found(it)) THEN 
    1305871        status_cnt = status_cnt+1 
    1306         IF (nb_to_ret > 1) THEN 
    1307           WRITE(str_tmp,'(a,"__",I3.3)') TRIM(TARGET),it 
    1308         ELSE 
    1309           str_tmp = TRIM(TARGET) 
     872        IF      (status_cnt <= max_msgs) THEN 
     873          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', & 
     874 &               ADVANCE='NO') TRIM(target) 
     875          IF (nb_to_ret > 1) THEN 
     876            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO') 
     877            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it 
     878          ENDIF 
     879          SELECT CASE (k_typ) 
     880          CASE(k_i) 
     881            WRITE (UNIT=*,FMT=*) "=",i_val(it) 
     882          CASE(k_r) 
     883            WRITE (UNIT=*,FMT=*) "=",r_val(it) 
     884          CASE(k_c) 
     885            WRITE (UNIT=*,FMT=*) "=",c_val(it) 
     886          CASE(k_l) 
     887            WRITE (UNIT=*,FMT=*) "=",l_val(it) 
     888          END SELECT 
     889        ELSE IF (status_cnt == max_msgs+1) THEN 
     890          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)') 
    1310891        ENDIF 
    1311         WRITE(*,*) 'USING DEFAULTS : ',TRIM(str_tmp),'=',ret_val(it) 
    1312892      ENDIF 
    1313893    ENDDO 
    … …  
    1321901    ENDIF 
    1322902  ENDIF 
     903! Deallocate the memory 
     904  DEALLOCATE(found) 
    1323905!--------------------- 
    1324 END SUBROUTINE getfill 
    1325 !- 
     906END SUBROUTINE get_fil 
    1326907!=== 
     908SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val) 
     909!--------------------------------------------------------------------- 
     910!- Read the required variable in the database 
     911!--------------------------------------------------------------------- 
     912  IMPLICIT NONE 
     913!- 
     914  INTEGER :: pos,size_of_in 
     915  CHARACTER(LEN=*) :: target 
     916  INTEGER,DIMENSION(:),OPTIONAL          :: i_val 
     917  REAL,DIMENSION(:),OPTIONAL             :: r_val 
     918  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val 
     919  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val 
     920!- 
     921  INTEGER :: k_typ 
     922  CHARACTER(LEN=9) :: c_vtyp 
     923!--------------------------------------------------------------------- 
     924!- 
     925! Get the type of the argument 
     926  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val) 
     927  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) & 
     928 &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN 
     929    CALL ipslerr (3,'get_rdb', & 
     930 &   'Internal error','Unknown type of data',' ') 
     931  ENDIF 
     932!- 
     933  IF (keytype(pos) /= k_typ) THEN 
     934    CALL ipslerr (3,'get_rdb', & 
     935 &   'Wrong data type for keyword '//TRIM(target), & 
     936 &   '(NOT '//TRIM(c_vtyp)//')',' ') 
     937  ENDIF 
     938!- 
     939  IF (keycompress(pos) > 0) THEN 
     940    IF (    (keycompress(pos) /= size_of_in) & 
     941 &      .OR.(keymemlen(pos) /= 1) ) THEN 
     942      CALL ipslerr (3,'get_rdb', & 
     943 &     'Wrong compression length','for keyword '//TRIM(target),' ') 
     944    ELSE 
     945      SELECT CASE (k_typ) 
     946      CASE(k_i) 
     947        i_val(1:size_of_in) = i_mem(keymemstart(pos)) 
     948      CASE(k_r) 
     949        r_val(1:size_of_in) = r_mem(keymemstart(pos)) 
     950      END SELECT 
     951    ENDIF 
     952  ELSE 
     953    IF (keymemlen(pos) /= size_of_in) THEN 
     954      CALL ipslerr (3,'get_rdb', & 
     955 &     'Wrong array length','for keyword '//TRIM(target),' ') 
     956    ELSE 
     957      SELECT CASE (k_typ) 
     958      CASE(k_i) 
     959        i_val(1:size_of_in) = & 
     960 &        i_mem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1) 
     961      CASE(k_r) 
     962        r_val(1:size_of_in) = & 
     963 &        r_mem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1) 
     964      CASE(k_c) 
     965        c_val(1:size_of_in) = & 
     966 &        c_mem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1) 
     967      CASE(k_l) 
     968        l_val(1:size_of_in) = & 
     969 &        l_mem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1) 
     970      END SELECT 
     971    ENDIF 
     972  ENDIF 
     973!--------------------- 
     974END SUBROUTINE get_rdb 
     975!=== 
     976SUBROUTINE get_wdb & 
     977 &  (target,target_sig,status,fileorig,size_of_in, & 
     978 &   i_val,r_val,c_val,l_val) 
     979!--------------------------------------------------------------------- 
     980!- Write data into the data base 
     981!--------------------------------------------------------------------- 
     982  IMPLICIT NONE 
     983!- 
     984  CHARACTER(LEN=*) :: target 
     985  INTEGER :: target_sig,status,fileorig,size_of_in 
     986  INTEGER,DIMENSION(:),OPTIONAL          :: i_val 
     987  REAL,DIMENSION(:),OPTIONAL             :: r_val 
     988  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val 
     989  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val 
     990!- 
     991  INTEGER :: k_typ 
     992  CHARACTER(LEN=9) :: c_vtyp 
     993  INTEGER :: k_mempos,k_memsize,k_len 
     994  LOGICAL :: l_cmp 
     995!--------------------------------------------------------------------- 
     996!- 
     997! Get the type of the argument 
     998  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val) 
     999  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) & 
     1000 &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN 
     1001    CALL ipslerr (3,'get_wdb', & 
     1002 &   'Internal error','Unknown type of data',' ') 
     1003  ENDIF 
     1004!- 
     1005! First check if we have sufficiant space for the new key 
     1006  IF (nb_keys+1 > keymemsize) THEN 
     1007    CALL getin_allockeys () 
     1008  ENDIF 
     1009!- 
     1010  SELECT CASE (k_typ) 
     1011  CASE(k_i) 
     1012    k_mempos = i_mempos; k_memsize = i_memsize; 
     1013    l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) & 
     1014 &         .AND.(size_of_in > compress_lim) 
     1015  CASE(k_r) 
     1016    k_mempos = r_mempos; k_memsize = r_memsize; 
     1017    l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) & 
     1018 &         .AND.(size_of_in > compress_lim) 
     1019  CASE(k_c) 
     1020    k_mempos = c_mempos; k_memsize = c_memsize; 
     1021    l_cmp = .FALSE. 
     1022  CASE(k_l) 
     1023    k_mempos = l_mempos; k_memsize = l_memsize; 
     1024    l_cmp = .FALSE. 
     1025  END SELECT 
     1026!- 
     1027! Fill out the items of the data base 
     1028  nb_keys = nb_keys+1 
     1029  keysig(nb_keys) = target_sig 
     1030  keystr(nb_keys) = target(1:MIN(LEN_TRIM(target),l_n)) 
     1031  keystatus(nb_keys) = status 
     1032  keytype(nb_keys) = k_typ 
     1033  keyfromfile(nb_keys) = fileorig 
     1034  keymemstart(nb_keys) = k_mempos+1 
     1035  IF (l_cmp) THEN 
     1036    keycompress(nb_keys) = size_of_in 
     1037    keymemlen(nb_keys) = 1 
     1038  ELSE 
     1039    keycompress(nb_keys) = -1 
     1040    keymemlen(nb_keys) = size_of_in 
     1041  ENDIF 
     1042!- 
     1043! Before writing the actual size lets see if we have the space 
     1044  IF (keymemstart(nb_keys)+keymemlen(nb_keys) > k_memsize) THEN 
     1045    CALL getin_allocmem (k_typ,keymemlen(nb_keys)) 
     1046  ENDIF 
     1047!- 
     1048  k_len = keymemstart(nb_keys)+keymemlen(nb_keys)-1 
     1049  SELECT CASE (k_typ) 
     1050  CASE(k_i) 
     1051    i_mem(keymemstart(nb_keys):k_len) = i_val(1:keymemlen(nb_keys)) 
     1052    i_mempos = k_len 
     1053  CASE(k_r) 
     1054    r_mem(keymemstart(nb_keys):k_len) = r_val(1:keymemlen(nb_keys)) 
     1055    r_mempos = k_len 
     1056  CASE(k_c) 
     1057    c_mem(keymemstart(nb_keys):k_len) = c_val(1:keymemlen(nb_keys)) 
     1058    c_mempos = k_len 
     1059  CASE(k_l) 
     1060    l_mem(keymemstart(nb_keys):k_len) = l_val(1:keymemlen(nb_keys)) 
     1061    l_mempos = k_len 
     1062  END SELECT 
     1063!--------------------- 
     1064END SUBROUTINE get_wdb 
     1065!- 
     1066!=== 
    13271067!- 
    13281068SUBROUTINE getin_read 
    … …  
    13311071!- 
    13321072  INTEGER,SAVE :: allread=0 
    1333   INTEGER,SAVE :: current,i 
     1073  INTEGER,SAVE :: current 
    13341074!--------------------------------------------------------------------- 
    13351075  IF (allread == 0) THEN 
    13361076!-- Allocate a first set of memory. 
    13371077    CALL getin_allockeys 
    1338     CALL getin_allocmem (1,0) 
    1339     CALL getin_allocmem (2,0) 
    1340     CALL getin_allocmem (3,0) 
    1341     CALL getin_allocmem (4,0) 
     1078    CALL getin_allocmem (k_i,0) 
     1079    CALL getin_allocmem (k_r,0) 
     1080    CALL getin_allocmem (k_c,0) 
     1081    CALL getin_allocmem (k_l,0) 
    13421082!-- Start with reading the files 
    13431083    nbfiles = 1 
    … …  
    13681108  INTEGER :: current 
    13691109!- 
    1370   CHARACTER(LEN=100) :: READ_str, NEW_str, new_key, last_key, key_str 
    1371   CHARACTER(LEN=3) :: cnt 
     1110  CHARACTER(LEN=100) :: READ_str,NEW_str,last_key,key_str 
     1111  CHARACTER(LEN=n_d_fmt) :: cnt 
     1112  CHARACTER(LEN=10) :: c_fmt 
    13721113  INTEGER :: nb_lastkey 
    13731114!- 
    1374   INTEGER :: eof, ptn, len_str, i, it, iund 
     1115  INTEGER :: eof,ptn,len_str,i,it,iund,io_err 
    13751116  LOGICAL :: check = .FALSE. 
    13761117!--------------------------------------------------------------------- 
    … …  
    13831124  ENDIF 
    13841125!- 
    1385   OPEN (22,file=filelist(current),ERR=9997,STATUS="OLD") 
     1126  OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err) 
     1127  IF (io_err /= 0) THEN 
     1128    CALL ipslerr (2,'getin_readdef', & 
     1129 &  'Could not open file '//TRIM(filelist(current)),' ',' ') 
     1130    RETURN 
     1131  ENDIF 
    13861132!- 
    13871133  DO WHILE (eof /= 1) 
    … …  
    13941140!---- Get the target 
    13951141      key_str = TRIM(ADJUSTL(READ_str(1:ptn-1))) 
    1396 !---- Make sure that if a vector keyword has the right length 
    1397       iund =  INDEX(key_str,'__') 
     1142!---- Make sure that a vector keyword has the right length 
     1143      iund = INDEX(key_str,'__') 
    13981144      IF (iund > 0) THEN 
    1399         SELECTCASE( len_trim(key_str)-iund ) 
    1400           CASE(2) 
    1401             READ(key_str(iund+2:len_trim(key_str)),'(I1)') it 
    1402           CASE(3) 
    1403             READ(key_str(iund+2:len_trim(key_str)),'(I2)') it 
    1404           CASE(4) 
    1405             READ(key_str(iund+2:len_trim(key_str)),'(I3)') it 
    1406           CASE DEFAULT 
    1407             it = -1 
    1408         END SELECT 
    1409         IF (it > 0) THEN 
    1410           WRITE(cnt,'(I3.3)') it 
     1145        WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') & 
     1146 &        LEN_TRIM(key_str)-iund-1 
     1147        READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), & 
     1148 &           FMT=c_fmt,IOSTAT=io_err) it 
     1149        IF ( (io_err == 0).AND.(it > 0) ) THEN 
     1150          WRITE(UNIT=cnt,FMT=c_i_fmt) it 
    14111151          key_str = key_str(1:iund+1)//cnt 
    14121152        ELSE 
    1413           WRITE(*,*) & 
    1414  &          'getin_readdef : A very strange key has just been found' 
    1415           WRITE(*,*) 'getin_readdef : ',key_str(1:len_TRIM(key_str)) 
    1416           STOP 'getin_readdef' 
     1153          CALL ipslerr (3,'getin_readdef', & 
     1154 &         'A very strange key has just been found :', & 
     1155 &         TRIM(key_str),' ') 
    14171156        ENDIF 
    14181157      ENDIF 
    … …  
    14431182        ELSE 
    14441183          IF (nb_lastkey /= 1) THEN 
    1445             WRITE(*,*) & 
    1446  &   'getin_readdef : An error has occured. We can not have a scalar' 
    1447             WRITE(*,*) 'getin_readdef : keywod and a vector content' 
    1448             STOP 'getin_readdef' 
     1184            CALL ipslerr (3,'getin_readdef', & 
     1185 &           'We can not have a scalar keyword', & 
     1186 &           'and a vector content',' ') 
    14491187          ENDIF 
    14501188!-------- The last keyword needs to be transformed into a vector. 
     1189          WRITE(UNIT=cnt,FMT=c_i_fmt) 1 
    14511190          targetlist(nb_lines) = & 
    1452  &          last_key(1:MIN(len_trim(last_key),30))//'__001' 
     1191 &         last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt 
    14531192          CALL gensig (targetlist(nb_lines),targetsiglist(nb_lines)) 
    1454           key_str = last_key(1:len_TRIM(last_key)) 
     1193          key_str = last_key(1:LEN_TRIM(last_key)) 
    14551194        ENDIF 
    14561195      ENDIF 
    … …  
    14591198      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey) 
    14601199    ELSE 
    1461 !---- If we have an empty line the the keyword finishes 
     1200!---- If we have an empty line then the keyword finishes 
    14621201      nb_lastkey = 0 
    14631202      IF (check) THEN 
    … …  
    14671206  ENDDO 
    14681207!- 
    1469   CLOSE(22) 
     1208  CLOSE(UNIT=22) 
    14701209!- 
    14711210  IF (check) THEN 
    1472     OPEN (22,file='run.def.test') 
     1211    OPEN (UNIT=22,file='run.def.test') 
    14731212    DO i=1,nb_lines 
    1474       WRITE(22,*) targetlist(i)," : ",fichier(i) 
     1213      WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i) 
    14751214    ENDDO 
    1476     CLOSE(22) 
    1477   ENDIF 
    1478 !- 
    1479   RETURN 
    1480 !- 
    1481 9997 WRITE(*,*) "getin_readdef : Could not open file ", & 
    1482           & TRIM(filelist(current)) 
     1215    CLOSE(UNIT=22) 
     1216  ENDIF 
    14831217!--------------------------- 
    14841218END SUBROUTINE getin_readdef 
    … …  
    14961230! ARGUMENTS 
    14971231!- 
    1498   INTEGER :: current, nb_lastkey 
    1499   CHARACTER(LEN=*) :: key_str, NEW_str, last_key 
     1232  INTEGER :: current,nb_lastkey 
     1233  CHARACTER(LEN=*) :: key_str,NEW_str,last_key 
    15001234!- 
    15011235! LOCAL 
    15021236!- 
    1503   INTEGER :: len_str, blk, nbve, starpos 
    1504   CHARACTER(LEN=100) :: tmp_str, new_key, mult 
    1505   CHARACTER(LEN=3)   :: cnt, chlen 
    1506   CHARACTER(LEN=10)  :: fmt 
     1237  INTEGER :: len_str,blk,nbve,starpos 
     1238  CHARACTER(LEN=100) :: tmp_str,new_key,mult 
     1239  CHARACTER(LEN=n_d_fmt) :: cnt 
     1240  CHARACTER(LEN=10) :: c_fmt 
    15071241!--------------------------------------------------------------------- 
    15081242  len_str = LEN_TRIM(NEW_str) 
    … …  
    15161250    DO WHILE (blk > 0) 
    15171251      IF (nbfiles+1 > max_files) THEN 
    1518         WRITE(*,*) 'FATAL ERROR : Too many files to include' 
    1519         STOP 'getin_readdef' 
     1252        CALL ipslerr (3,'getin_decrypt', & 
     1253 &       'Too many files to include',' ',' ') 
    15201254      ENDIF 
    15211255!----- 
    … …  
    15281262!--- 
    15291263    IF (nbfiles+1 > max_files) THEN 
    1530       WRITE(*,*) 'FATAL ERROR : Too many files to include' 
    1531       STOP 'getin_readdef' 
     1264      CALL ipslerr (3,'getin_decrypt', & 
     1265 &     'Too many files to include',' ',' ') 
    15321266    ENDIF 
    15331267!--- 
    … …  
    15431277    nb_lines = nb_lines+1 
    15441278    IF (nb_lines > max_lines) THEN 
    1545       WRITE(*,*) & 
    1546  &      'Too many line in the run.def files. You need to increase' 
    1547       WRITE(*,*) 'the parameter max_lines in the module getincom.' 
    1548       STOP 'getin_decrypt' 
     1279      CALL ipslerr (3,'getin_decrypt', & 
     1280 &     'Too many lines in the run.def files.', & 
     1281 &     'You need to increase', & 
     1282 &     'the parameter max_lines in the module getincom.') 
    15491283    ENDIF 
    15501284!- 
    … …  
    15561290 &                    .AND.(tmp_str(1:1) /= "'") ) THEN 
    15571291!----- 
    1558       IF (INDEX(key_str(1:len_TRIM(key_str)),'__') > 0) THEN 
    1559         WRITE(*,*) 'ERROR : getin_decrypt' 
    1560         WRITE(*,*) & 
    1561 &         'We can not have a compressed field of values for in a' 
    1562         WRITE(*,*) & 
    1563 &         'vector notation. If a target is of the type TARGET__1' 
    1564         WRITE(*,*) 'then only a scalar value is allowed' 
    1565         WRITE(*,*) 'The key at fault : ',key_str(1:len_TRIM(key_str)) 
    1566         STOP 'getin_decrypt' 
     1292      IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN 
     1293        CALL ipslerr (3,'getin_decrypt', & 
     1294 &       'We can not have a compressed field of values', & 
     1295 &       'in a vector notation (TARGET__n).', & 
     1296 &       'The key at fault : '//TRIM(key_str)) 
    15671297      ENDIF 
    15681298!- 
    … …  
    15751305      blk = INDEX(NEW_str(1:len_str),' ') 
    15761306      IF (blk > 1) THEN 
    1577         WRITE(*,*) & 
    1578  &       'This is a strange behavior of getin_decrypt you could report' 
    1579       ENDIF 
    1580       WRITE(chlen,'(I3.3)') LEN_TRIM(mult) 
    1581       fmt = '(I'//chlen//')' 
    1582       READ(mult,fmt) compline(nb_lines) 
     1307        CALL ipslerr (2,'getin_decrypt', & 
     1308 &       'This is a strange behavior','you could report',' ') 
     1309      ENDIF 
     1310      WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult) 
     1311      READ(UNIT=mult,FMT=c_fmt) compline(nb_lines) 
    15831312!--- 
    15841313    ELSE 
    … …  
    15881317!-- If there is no space wthin the line then the target is a scalar 
    15891318!-- or the element of a properly written vector. 
    1590 !-- (ie of the type TARGET__1) 
     1319!-- (ie of the type TARGET__00001) 
    15911320!- 
    15921321    IF (    (blk <= 1) & 
    … …  
    15971326!------ Save info of current keyword as a scalar 
    15981327!------ if it is not a continuation 
    1599         targetlist(nb_lines) = key_str(1:MIN(len_trim(key_str),30)) 
    1600         last_key = key_str(1:MIN(len_trim(key_str),30)) 
     1328        targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n)) 
     1329        last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n)) 
    16011330        nb_lastkey = 1 
    16021331      ELSE 
    16031332!------ We are continuing a vector so the keyword needs 
    16041333!------ to get the underscores 
    1605         WRITE(cnt,'(I3.3)') nb_lastkey+1 
     1334        WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1 
    16061335        targetlist(nb_lines) = & 
    1607  &        key_str(1:MIN(len_trim(key_str),25))//'__'//cnt 
    1608         last_key = key_str(1:MIN(len_trim(key_str),25))//'__'//cnt 
     1336 &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt 
     1337        last_key = & 
     1338 &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt 
    16091339        nb_lastkey = nb_lastkey+1 
    16101340      ENDIF 
    … …  
    16171347!---- If there are blanks whithin the line then we are dealing 
    16181348!---- with a vector and we need to split it in many entries 
    1619 !---- with the TRAGET__1 notation. 
     1349!---- with the TARGET__n notation. 
    16201350!---- 
    16211351!---- Test if the targer is not already a vector target ! 
    16221352!- 
    16231353      IF (INDEX(TRIM(key_str),'__') > 0) THEN 
    1624         WRITE(*,*) 'ERROR : getin_decrypt' 
    1625         WRITE(*,*) 'We have found a mixed vector notation' 
    1626         WRITE(*,*) 'If a target is of the type TARGET__1' 
    1627         WRITE(*,*) 'then only a scalar value is allowed' 
    1628         WRITE(*,*) 'The key at fault : ',key_str(1:len_TRIM(key_str)) 
    1629         STOP 'getin_decrypt' 
     1354        CALL ipslerr (3,'getin_decrypt', & 
     1355 &       'We have found a mixed vector notation (TARGET__n).', & 
     1356 &       'The key at fault : '//TRIM(key_str),' ') 
    16301357      ENDIF 
    16311358!- 
    16321359      nbve = nb_lastkey 
    16331360      nbve = nbve+1 
    1634       WRITE(cnt,'(I3.3)') nbve 
     1361      WRITE(UNIT=cnt,FMT=c_i_fmt) nbve 
    16351362!- 
    16361363      DO WHILE (blk > 0) 
    … …  
    16391366!- 
    16401367        fichier(nb_lines) = tmp_str(1:blk) 
    1641         new_key =  key_str(1:MIN(len_trim(key_str),25))//'__'//cnt 
    1642         targetlist(nb_lines) = new_key(1:MIN(len_trim(new_key),30)) 
     1368        new_key = & 
     1369 &       key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt 
     1370        targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n)) 
    16431371        CALL gensig (targetlist(nb_lines),targetsiglist(nb_lines)) 
    16441372        fromfile(nb_lines) = current 
    … …  
    16491377        nb_lines = nb_lines+1 
    16501378        IF (nb_lines > max_lines) THEN 
    1651           WRITE(*,*) & 
    1652  &          'Too many line in the run.def files. You need to increase' 
    1653           WRITE(*,*) 'the parameter max_lines in the module getincom.' 
    1654           STOP 'getin_decrypt' 
     1379          CALL ipslerr (3,'getin_decrypt', & 
     1380 &         'Too many lines in the run.def files.', & 
     1381 &         'You need to increase', & 
     1382 &         'the parameter max_lines in the module getincom.') 
    16551383        ENDIF 
    16561384        nbve = nbve+1 
    1657         WRITE(cnt,'(I3.3)') nbve 
     1385        WRITE(UNIT=cnt,FMT=c_i_fmt) nbve 
    16581386!- 
    16591387      ENDDO 
    … …  
    16621390!- 
    16631391      fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str)) 
    1664       new_key = key_str(1:MIN(len_trim(key_str),25))//'__'//cnt 
    1665       targetlist(nb_lines) = new_key(1:MIN(len_trim(new_key),30)) 
     1392      new_key = & 
     1393 &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt 
     1394      targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n)) 
    16661395      CALL gensig (targetlist(nb_lines),targetsiglist(nb_lines)) 
    16671396      fromfile(nb_lines) = current 
    16681397!- 
    1669       last_key = key_str(1:MIN(len_trim(key_str),25))//'__'//cnt 
     1398      last_key = & 
     1399 &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt 
    16701400      nb_lastkey = nbve 
    16711401!- 
    … …  
    16841414  IMPLICIT NONE 
    16851415!- 
    1686 ! Arguments 
    1687 !- 
    1688 !- 
    1689 ! LOCAL 
    1690 !- 
    1691   INTEGER :: line,i,sig 
    1692   INTEGER :: found 
    1693   CHARACTER(LEN=30) :: str 
     1416  INTEGER :: line,found 
    16941417!--------------------------------------------------------------------- 
    16951418  DO line=1,nb_lines-1 
    … …  
    17061429!----- 
    17071430      WRITE(*,*) & 
    1708  & 'getin_checkcohe : Found a problem on key ',targetlist(line) 
     1431 & 'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line)) 
    17091432      WRITE(*,*) & 
    17101433 & 'getin_checkcohe : The following values were encoutered :' 
    … …  
    17211444    ENDIF 
    17221445  ENDDO 
    1723 !- 
     1446!----------------------------- 
    17241447END SUBROUTINE getin_checkcohe 
    17251448!- 
    … …  
    17301453  IMPLICIT NONE 
    17311454!- 
    1732   INTEGER :: unit, eof, nb_lastkey 
     1455  INTEGER :: unit,eof,nb_lastkey 
    17331456  CHARACTER(LEN=100) :: dummy 
    17341457  CHARACTER(LEN=100) :: out_string 
    … …  
    17401463!- 
    17411464  DO WHILE (first == "#") 
    1742     READ (unit,'(a100)',ERR=9998,END=7778) dummy 
     1465    READ (UNIT=unit,FMT='(A)',ERR=9998,END=7778) dummy 
    17431466    dummy = TRIM(ADJUSTL(dummy)) 
    17441467    first=dummy(1:1) 
    … …  
    17511474  RETURN 
    17521475!- 
    1753 9998 WRITE(*,*) " GETIN_SKIPAFEW : Error while reading file " 
    1754   STOP 'getin_skipafew' 
    1755 !- 
    1756 7778 eof = 1 
     14769998 CONTINUE 
     1477  CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ') 
     1478!- 
     14797778 CONTINUE 
     1480  eof = 1 
    17571481!---------------------------- 
    17581482END SUBROUTINE getin_skipafew 
    17591483!- 
    1760 !=== INTEGER database INTERFACE 
    1761 !- 
    1762 SUBROUTINE getdbwi & 
    1763  &  (target,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
    1764 !--------------------------------------------------------------------- 
    1765 !- Write the INTEGER data into the data base 
    1766 !--------------------------------------------------------------------- 
    1767   IMPLICIT NONE 
    1768 !- 
    1769   CHARACTER(LEN=*) :: target 
    1770   INTEGER :: target_sig, status, fileorig, size_of_in 
    1771   INTEGER,DIMENSION(:) :: tmp_ret_val 
    1772 !--------------------------------------------------------------------- 
    1773 !- 
    1774 ! First check if we have sufficiant space for the new key 
    1775 !- 
    1776   IF (nb_keys+1 > keymemsize) THEN 
    1777     CALL getin_allockeys () 
    1778   ENDIF 
    1779 !- 
    1780 ! Fill out the items of the data base 
    1781 !- 
    1782   nb_keys = nb_keys+1 
    1783   keysig(nb_keys) = target_sig 
    1784   keystr(nb_keys) = target(1:MIN(len_trim(target),30)) 
    1785   keystatus(nb_keys) = status 
    1786   keytype(nb_keys) = 1 
    1787   keyfromfile(nb_keys) = fileorig 
    1788 !- 
    1789 ! Can we compress the data base entry ? 
    1790 !- 
    1791   IF (     (MINVAL(tmp_ret_val) == MAXVAL(tmp_ret_val)) & 
    1792  &    .AND.(size_of_in > compress_lim)) THEN 
    1793     keymemstart(nb_keys) = intmempos+1 
    1794     keycompress(nb_keys) = size_of_in 
    1795     keymemlen(nb_keys) = 1 
    1796   ELSE 
    1797     keymemstart(nb_keys) = intmempos+1 
    1798     keycompress(nb_keys) = -1 
    1799     keymemlen(nb_keys) = size_of_in 
    1800   ENDIF 
    1801 !- 
    1802 ! Before writing the actual size lets see if we have the space 
    1803 !- 
    1804   IF (keymemstart(nb_keys)+keymemlen(nb_keys) > intmemsize) THEN 
    1805     CALL getin_allocmem (1,keymemlen(nb_keys)) 
    1806   ENDIF 
    1807 !- 
    1808   intmem(keymemstart(nb_keys): & 
    1809  &       keymemstart(nb_keys)+keymemlen(nb_keys)-1) = & 
    1810  &  tmp_ret_val(1:keymemlen(nb_keys)) 
    1811   intmempos = keymemstart(nb_keys)+keymemlen(nb_keys)-1 
    1812 !--------------------- 
    1813 END SUBROUTINE getdbwi 
    1814 !- 
    1815 !=== 
    1816 !- 
    1817 SUBROUTINE getdbri (pos,size_of_in,target,tmp_ret_val) 
    1818 !--------------------------------------------------------------------- 
    1819 !- Read the required variables in the database for INTEGERS 
    1820 !--------------------------------------------------------------------- 
    1821   IMPLICIT NONE 
    1822 !- 
    1823   INTEGER :: pos, size_of_in 
    1824   CHARACTER(LEN=*) :: target 
    1825   INTEGER,DIMENSION(:) :: tmp_ret_val 
    1826 !--------------------------------------------------------------------- 
    1827   IF (keytype(pos) /= 1) THEN 
    1828     WRITE(*,*) 'FATAL ERROR : Wrong data type for keyword ',target 
    1829     STOP 'getdbri' 
    1830   ENDIF 
    1831 !- 
    1832   IF (keycompress(pos) > 0) THEN 
    1833     IF ( keycompress(pos) /= size_of_in .OR. keymemlen(pos) /= 1 ) THEN 
    1834       WRITE(*,*) & 
    1835  &      'FATAL ERROR : Wrong compression length for keyword ',target 
    1836       STOP 'getdbri' 
    1837     ELSE 
    1838       tmp_ret_val(1:size_of_in) = intmem(keymemstart(pos)) 
    1839     ENDIF 
    1840   ELSE 
    1841     IF (keymemlen(pos) /= size_of_in) THEN 
    1842       WRITE(*,*) 'FATAL ERROR : Wrong array length for keyword ',target 
    1843       STOP 'getdbri' 
    1844     ELSE 
    1845       tmp_ret_val(1:size_of_in) = & 
    1846  &      intmem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1) 
    1847     ENDIF 
    1848   ENDIF 
    1849 !--------------------- 
    1850 END SUBROUTINE getdbri 
    1851 !- 
    1852 !=== REAL database INTERFACE 
    1853 !- 
    1854 SUBROUTINE getdbwr & 
    1855  &  (target,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
    1856 !--------------------------------------------------------------------- 
    1857 !- Write the REAL data into the data base 
    1858 !--------------------------------------------------------------------- 
    1859   IMPLICIT NONE 
    1860 !- 
    1861   CHARACTER(LEN=*) :: target 
    1862   INTEGER :: target_sig, status, fileorig, size_of_in 
    1863   REAL,DIMENSION(:) :: tmp_ret_val 
    1864 !--------------------------------------------------------------------- 
    1865 !- 
    1866 ! First check if we have sufficiant space for the new key 
    1867 !- 
    1868   IF (nb_keys+1 > keymemsize) THEN 
    1869     CALL getin_allockeys () 
    1870   ENDIF 
    1871 !- 
    1872 ! Fill out the items of the data base 
    1873 !- 
    1874   nb_keys = nb_keys+1 
    1875   keysig(nb_keys) = target_sig 
    1876   keystr(nb_keys) = target(1:MIN(len_trim(target),30)) 
    1877   keystatus(nb_keys) = status 
    1878   keytype(nb_keys) = 2 
    1879   keyfromfile(nb_keys) = fileorig 
    1880 !- 
    1881 ! Can we compress the data base entry ? 
    1882 !- 
    1883   IF (     (MINVAL(tmp_ret_val) == MAXVAL(tmp_ret_val)) & 
    1884 &     .AND.(size_of_in > compress_lim)) THEN 
    1885     keymemstart(nb_keys) = realmempos+1 
    1886     keycompress(nb_keys) = size_of_in 
    1887     keymemlen(nb_keys) = 1 
    1888   ELSE 
    1889     keymemstart(nb_keys) = realmempos+1 
    1890     keycompress(nb_keys) = -1 
    1891     keymemlen(nb_keys) = size_of_in 
    1892   ENDIF 
    1893 !- 
    1894 ! Before writing the actual size lets see if we have the space 
    1895 !- 
    1896   IF (keymemstart(nb_keys)+keymemlen(nb_keys) > realmemsize) THEN 
    1897     CALL getin_allocmem (2,keymemlen(nb_keys)) 
    1898   ENDIF 
    1899 !- 
    1900   realmem(keymemstart(nb_keys): & 
    1901  &        keymemstart(nb_keys)+keymemlen(nb_keys)-1) = & 
    1902  &  tmp_ret_val(1:keymemlen(nb_keys)) 
    1903   realmempos = keymemstart(nb_keys)+keymemlen(nb_keys)-1 
    1904 !--------------------- 
    1905 END SUBROUTINE getdbwr 
    1906 !- 
    1907 !=== 
    1908 !- 
    1909 SUBROUTINE getdbrr (pos,size_of_in,target,tmp_ret_val) 
    1910 !--------------------------------------------------------------------- 
    1911 !- Read the required variables in the database for REALS 
    1912 !--------------------------------------------------------------------- 
    1913   IMPLICIT NONE 
    1914 !- 
    1915   INTEGER :: pos, size_of_in 
    1916   CHARACTER(LEN=*) :: target 
    1917   REAL,DIMENSION(:) :: tmp_ret_val 
    1918 !--------------------------------------------------------------------- 
    1919   IF (keytype(pos) /= 2) THEN 
    1920     WRITE(*,*) 'FATAL ERROR : Wrong data type for keyword ',target 
    1921     STOP 'getdbrr' 
    1922   ENDIF 
    1923 !- 
    1924   IF (keycompress(pos) > 0) THEN 
    1925     IF (    (keycompress(pos) /= size_of_in) & 
    1926  &      .OR.(keymemlen(pos) /= 1) ) THEN 
    1927       WRITE(*,*) & 
    1928  &      'FATAL ERROR : Wrong compression length for keyword ',target 
    1929       STOP 'getdbrr' 
    1930     ELSE 
    1931       tmp_ret_val(1:size_of_in) = realmem(keymemstart(pos)) 
    1932     ENDIF 
    1933   ELSE 
    1934     IF (keymemlen(pos) /= size_of_in) THEN 
    1935       WRITE(*,*) 'FATAL ERROR : Wrong array length for keyword ',target 
    1936       STOP 'getdbrr' 
    1937     ELSE 
    1938       tmp_ret_val(1:size_of_in) = & 
    1939  &      realmem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1) 
    1940     ENDIF 
    1941   ENDIF 
    1942 !--------------------- 
    1943 END SUBROUTINE getdbrr 
    1944 !- 
    1945 !=== CHARACTER database INTERFACE 
    1946 !- 
    1947 SUBROUTINE getdbwc & 
    1948  &  (target,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
    1949 !--------------------------------------------------------------------- 
    1950 !- Write the CHARACTER data into the data base 
    1951 !--------------------------------------------------------------------- 
    1952   IMPLICIT NONE 
    1953 !- 
    1954   CHARACTER(LEN=*) :: target 
    1955   INTEGER :: target_sig,status,fileorig,size_of_in 
    1956   CHARACTER(LEN=*),DIMENSION(:) :: tmp_ret_val 
    1957 !--------------------------------------------------------------------- 
    1958 !- 
    1959 ! First check if we have sufficiant space for the new key 
    1960 !- 
    1961   IF (nb_keys+1 > keymemsize) THEN 
    1962     CALL getin_allockeys () 
    1963   ENDIF 
    1964 !- 
    1965 ! Fill out the items of the data base 
    1966 !- 
    1967   nb_keys = nb_keys+1 
    1968   keysig(nb_keys) = target_sig 
    1969   keystr(nb_keys) = target(1:MIN(len_trim(target),30)) 
    1970   keystatus(nb_keys) = status 
    1971   keytype(nb_keys) = 3 
    1972   keyfromfile(nb_keys) = fileorig 
    1973   keymemstart(nb_keys) = charmempos+1 
    1974   keymemlen(nb_keys) = size_of_in 
    1975 !- 
    1976 ! Before writing the actual size lets see if we have the space 
    1977 !- 
    1978   IF (keymemstart(nb_keys)+keymemlen(nb_keys) > realmemsize) THEN 
    1979     CALL getin_allocmem (3,keymemlen(nb_keys)) 
    1980   ENDIF 
    1981 !- 
    1982   charmem(keymemstart(nb_keys): & 
    1983  &        keymemstart(nb_keys)+keymemlen(nb_keys)-1) = & 
    1984  &  tmp_ret_val(1:keymemlen(nb_keys)) 
    1985   charmempos = keymemstart(nb_keys)+keymemlen(nb_keys)-1 
    1986 !--------------------- 
    1987 END SUBROUTINE getdbwc 
    1988 !- 
    1989 !=== 
    1990 !- 
    1991 SUBROUTINE getdbrc(pos,size_of_in,target,tmp_ret_val) 
    1992 !--------------------------------------------------------------------- 
    1993 !- Read the required variables in the database for CHARACTER 
    1994 !--------------------------------------------------------------------- 
    1995   IMPLICIT NONE 
    1996 !- 
    1997   INTEGER :: pos, size_of_in 
    1998   CHARACTER(LEN=*) :: target 
    1999   CHARACTER(LEN=*),DIMENSION(:) :: tmp_ret_val 
    2000 !--------------------------------------------------------------------- 
    2001   IF (keytype(pos) /= 3) THEN 
    2002     WRITE(*,*) 'FATAL ERROR : Wrong data type for keyword ',target 
    2003     STOP 'getdbrc' 
    2004   ENDIF 
    2005 !- 
    2006   IF (keymemlen(pos) /= size_of_in) THEN 
    2007     WRITE(*,*) 'FATAL ERROR : Wrong array length for keyword ',target 
    2008     STOP 'getdbrc' 
    2009   ELSE 
    2010     tmp_ret_val(1:size_of_in) = & 
    2011  &    charmem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1) 
    2012   ENDIF 
    2013 !--------------------- 
    2014 END SUBROUTINE getdbrc 
    2015 !- 
    2016 !=== LOGICAL database INTERFACE 
    2017 !- 
    2018 SUBROUTINE getdbwl & 
    2019  &  (target,target_sig,status,fileorig,size_of_in,tmp_ret_val) 
    2020 !--------------------------------------------------------------------- 
    2021 !- Write the LOGICAL data into the data base 
    2022 !--------------------------------------------------------------------- 
    2023   IMPLICIT NONE 
    2024 !- 
    2025   CHARACTER(LEN=*) :: target 
    2026   INTEGER :: target_sig, status, fileorig, size_of_in 
    2027   LOGICAL,DIMENSION(:) :: tmp_ret_val 
    2028 !--------------------------------------------------------------------- 
    2029 !- 
    2030 ! First check if we have sufficiant space for the new key 
    2031 !- 
    2032   IF (nb_keys+1 > keymemsize) THEN 
    2033     CALL getin_allockeys () 
    2034   ENDIF 
    2035 !- 
    2036 ! Fill out the items of the data base 
    2037 !- 
    2038   nb_keys = nb_keys+1 
    2039   keysig(nb_keys) = target_sig 
    2040   keystr(nb_keys) = target(1:MIN(len_trim(target),30)) 
    2041   keystatus(nb_keys) = status 
    2042   keytype(nb_keys) = 4 
    2043   keyfromfile(nb_keys) = fileorig 
    2044   keymemstart(nb_keys) = logicmempos+1 
    2045   keymemlen(nb_keys) = size_of_in 
    2046 !- 
    2047 ! Before writing the actual size lets see if we have the space 
    2048 !- 
    2049   IF (keymemstart(nb_keys)+keymemlen(nb_keys) > logicmemsize) THEN 
    2050     CALL getin_allocmem (4,keymemlen(nb_keys)) 
    2051   ENDIF 
    2052 !- 
    2053   logicmem(keymemstart(nb_keys): & 
    2054  &         keymemstart(nb_keys)+keymemlen(nb_keys)-1) = & 
    2055  &  tmp_ret_val(1:keymemlen(nb_keys)) 
    2056   logicmempos = keymemstart(nb_keys)+keymemlen(nb_keys)-1 
    2057 !--------------------- 
    2058 END SUBROUTINE getdbwl 
    2059 !- 
    2060 !=== 
    2061 !- 
    2062 SUBROUTINE getdbrl(pos,size_of_in,target,tmp_ret_val) 
    2063 !--------------------------------------------------------------------- 
    2064 !- Read the required variables in the database for LOGICALS 
    2065 !--------------------------------------------------------------------- 
    2066   IMPLICIT NONE 
    2067 !- 
    2068   INTEGER :: pos, size_of_in 
    2069   CHARACTER(LEN=*) :: target 
    2070   LOGICAL,DIMENSION(:) :: tmp_ret_val 
    2071 !--------------------------------------------------------------------- 
    2072   IF (keytype(pos) /= 4) THEN 
    2073     WRITE(*,*) 'FATAL ERROR : Wrong data type for keyword ',target 
    2074     STOP 'getdbrl' 
    2075   ENDIF 
    2076 !- 
    2077   IF (keymemlen(pos) /= size_of_in) THEN 
    2078     WRITE(*,*) 'FATAL ERROR : Wrong array length for keyword ',target 
    2079     STOP 'getdbrl' 
    2080   ELSE 
    2081     tmp_ret_val(1:size_of_in) = & 
    2082  &    logicmem(keymemstart(pos):keymemstart(pos)+keymemlen(pos)-1) 
    2083   ENDIF 
    2084 !--------------------- 
    2085 END SUBROUTINE getdbrl 
    2086 !- 
    20871484!=== 
    20881485!- 
    … …  
    20951492!- 
    20961493  INTEGER :: ier 
     1494  CHARACTER(LEN=20) :: c_tmp 
    20971495!--------------------------------------------------------------------- 
    20981496!- 
    … …  
    21001498!- 
    21011499  IF (keymemsize == 0) THEN 
    2102 !- 
     1500!--- 
     1501    WRITE (UNIT=c_tmp,FMT=*) memslabs 
     1502!--- 
    21031503    ALLOCATE(keysig(memslabs),stat=ier) 
    21041504    IF (ier /= 0) THEN 
    2105       WRITE(*,*) & 
    2106  &      'getin_allockeys : Can not allocate keysig to size ', & 
    2107  &      memslabs 
    2108       STOP 
    2109     ENDIF 
    2110 !- 
     1505      CALL ipslerr (3,'getin_allockeys', & 
     1506 &     'Can not allocate keysig', & 
     1507 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1508    ENDIF 
     1509!--- 
    21111510    ALLOCATE(keystr(memslabs),stat=ier) 
    21121511    IF (ier /= 0) THEN 
    2113       WRITE(*,*) & 
    2114  &      'getin_allockeys : Can not allocate keystr to size ', & 
    2115  &      memslabs 
    2116       STOP 
    2117     ENDIF 
    2118 !- 
     1512      CALL ipslerr (3,'getin_allockeys', & 
     1513 &     'Can not allocate keystr', & 
     1514 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1515    ENDIF 
     1516!--- 
    21191517    ALLOCATE(keystatus(memslabs),stat=ier) 
    21201518    IF (ier /= 0) THEN 
    2121       WRITE(*,*) & 
    2122  &      'getin_allockeys : Can not allocate keystatus to size ', & 
    2123  &      memslabs 
    2124       STOP 
    2125     ENDIF 
    2126 !- 
     1519      CALL ipslerr (3,'getin_allockeys', & 
     1520 &     'Can not allocate keystatus', & 
     1521 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1522    ENDIF 
     1523!--- 
    21271524    ALLOCATE(keytype(memslabs),stat=ier) 
    21281525    IF (ier /= 0) THEN 
    2129       WRITE(*,*) & 
    2130  &      'getin_allockeys : Can not allocate keytype to size ', & 
    2131  &      memslabs 
    2132       STOP 
    2133     ENDIF 
    2134 !- 
     1526      CALL ipslerr (3,'getin_allockeys', & 
     1527 &     'Can not allocate keytype', & 
     1528 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1529    ENDIF 
     1530!--- 
    21351531    ALLOCATE(keycompress(memslabs),stat=ier) 
    21361532    IF (ier /= 0) THEN 
    2137       WRITE(*,*) & 
    2138  &      'getin_allockeys : Can not allocate keycompress to size ', & 
    2139  &      memslabs 
    2140       STOP 
    2141     ENDIF 
    2142 !- 
     1533      CALL ipslerr (3,'getin_allockeys', & 
     1534 &     'Can not allocate keycompress', & 
     1535 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1536    ENDIF 
     1537!--- 
    21431538    ALLOCATE(keyfromfile(memslabs),stat=ier) 
    21441539    IF (ier /= 0) THEN 
    2145       WRITE(*,*) & 
    2146  &      'getin_allockeys : Can not allocate keyfromfile to size ', & 
    2147  &      memslabs 
    2148       STOP 
    2149     ENDIF 
    2150 !- 
     1540      CALL ipslerr (3,'getin_allockeys', & 
     1541 &     'Can not allocate keyfromfile', & 
     1542 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1543    ENDIF 
     1544!--- 
    21511545    ALLOCATE(keymemstart(memslabs),stat=ier) 
    21521546    IF (ier /= 0) THEN 
    2153       WRITE(*,*) & 
    2154  &      'getin_allockeys : Can not allocate keymemstart to size ', & 
    2155  &      memslabs 
    2156       STOP 
    2157     ENDIF 
    2158 !- 
     1547      CALL ipslerr (3,'getin_allockeys', & 
     1548 &     'Can not allocate keymemstart', & 
     1549 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1550    ENDIF 
     1551!--- 
    21591552    ALLOCATE(keymemlen(memslabs),stat=ier) 
    21601553    IF (ier /= 0) THEN 
    2161       WRITE(*,*) & 
    2162  &      'getin_allockeys : Can not allocate keymemlen to size ', & 
    2163  &      memslabs 
    2164       STOP 
    2165     ENDIF 
    2166 !- 
     1554      CALL ipslerr (3,'getin_allockeys', & 
     1555 &     'Can not allocate keymemlen', & 
     1556 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1557    ENDIF 
     1558!--- 
    21671559    nb_keys = 0 
    21681560    keymemsize = memslabs 
    21691561    keycompress(:) = -1 
    2170 !- 
     1562!--- 
    21711563  ELSE 
    2172 !- 
     1564!--- 
    21731565!-- There is something already in the memory, 
    21741566!-- we need to transfer and reallocate. 
    2175 !- 
     1567!--- 
     1568    WRITE (UNIT=c_tmp,FMT=*) keymemsize 
     1569!--- 
    21761570    ALLOCATE(tmp_str(keymemsize),stat=ier) 
    21771571    IF (ier /= 0) THEN 
    2178       WRITE(*,*) & 
    2179  &      'getin_allockeys : Can not allocate tmp_str to size ', & 
    2180  &      keymemsize 
    2181       STOP 
    2182     ENDIF 
    2183 !- 
     1572      CALL ipslerr (3,'getin_allockeys', & 
     1573 &     'Can not allocate tmp_str', & 
     1574 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1575    ENDIF 
     1576!--- 
    21841577    ALLOCATE(tmp_int(keymemsize),stat=ier) 
    21851578    IF (ier /= 0) THEN 
    2186       WRITE(*,*) & 
    2187  &      'getin_allockeys : Can not allocate tmp_int to size ', & 
    2188  &      keymemsize 
    2189       STOP 
    2190     ENDIF 
    2191 !- 
     1579      CALL ipslerr (3,'getin_allockeys', & 
     1580 &     'Can not allocate tmp_int', & 
     1581 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1582    ENDIF 
     1583!--- 
     1584    WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs 
     1585!--- 
    21921586    tmp_int(1:keymemsize) = keysig(1:keymemsize) 
    21931587    DEALLOCATE(keysig) 
    21941588    ALLOCATE(keysig(keymemsize+memslabs),stat=ier) 
    21951589    IF (ier /= 0) THEN 
    2196       WRITE(*,*) & 
    2197  &      'getin_allockeys : Can not allocate keysig to size ', & 
    2198  &      keymemsize+memslabs 
    2199       STOP 
     1590      CALL ipslerr (3,'getin_allockeys', & 
     1591 &     'Can not allocate keysig', & 
     1592 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
    22001593    ENDIF 
    22011594    keysig(1:keymemsize) = tmp_int(1:keymemsize) 
    2202 !- 
     1595!--- 
    22031596    tmp_str(1:keymemsize) = keystr(1:keymemsize) 
    22041597    DEALLOCATE(keystr) 
    22051598    ALLOCATE(keystr(keymemsize+memslabs),stat=ier) 
    22061599    IF (ier /= 0) THEN 
    2207       WRITE(*,*) & 
    2208  &      'getin_allockeys : Can not allocate keystr to size ', & 
    2209  &      keymemsize+memslabs 
    2210       STOP 
     1600      CALL ipslerr (3,'getin_allockeys', & 
     1601 &     'Can not allocate keystr', & 
     1602 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
    22111603    ENDIF 
    22121604    keystr(1:keymemsize) = tmp_str(1:keymemsize) 
    2213 !- 
     1605!--- 
    22141606    tmp_int(1:keymemsize) = keystatus(1:keymemsize) 
    22151607    DEALLOCATE(keystatus) 
    22161608    ALLOCATE(keystatus(keymemsize+memslabs),stat=ier) 
    22171609    IF (ier /= 0) THEN 
    2218       WRITE(*,*) & 
    2219  &      'getin_allockeys : Can not allocate keystatus to size ', & 
    2220  &      keymemsize+memslabs 
    2221       STOP 
     1610      CALL ipslerr (3,'getin_allockeys', & 
     1611 &     'Can not allocate keystatus', & 
     1612 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
    22221613    ENDIF 
    22231614    keystatus(1:keymemsize) = tmp_int(1:keymemsize) 
    2224 !- 
     1615!--- 
    22251616    tmp_int(1:keymemsize) = keytype(1:keymemsize) 
    22261617    DEALLOCATE(keytype) 
    22271618    ALLOCATE(keytype(keymemsize+memslabs),stat=ier) 
    22281619    IF (ier /= 0) THEN 
    2229       WRITE(*,*) & 
    2230  &      'getin_allockeys : Can not allocate keytype to size ', & 
    2231  &      keymemsize+memslabs 
    2232       STOP 
     1620      CALL ipslerr (3,'getin_allockeys', & 
     1621 &     'Can not allocate keytype', & 
     1622 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
    22331623    ENDIF 
    22341624    keytype(1:keymemsize) = tmp_int(1:keymemsize) 
    2235 !- 
     1625!--- 
    22361626    tmp_int(1:keymemsize) = keycompress(1:keymemsize) 
    22371627    DEALLOCATE(keycompress) 
    22381628    ALLOCATE(keycompress(keymemsize+memslabs),stat=ier) 
    22391629    IF (ier /= 0) THEN 
    2240       WRITE(*,*) & 
    2241  &      'getin_allockeys : Can not allocate keycompress to size ', & 
    2242  &      keymemsize+memslabs 
    2243       STOP 
     1630      CALL ipslerr (3,'getin_allockeys', & 
     1631 &     'Can not allocate keycompress', & 
     1632 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
    22441633    ENDIF 
    22451634    keycompress(:) = -1 
    22461635    keycompress(1:keymemsize) = tmp_int(1:keymemsize) 
    2247 !- 
     1636!--- 
    22481637    tmp_int(1:keymemsize) = keyfromfile(1:keymemsize) 
    22491638    DEALLOCATE(keyfromfile) 
    22501639    ALLOCATE(keyfromfile(keymemsize+memslabs),stat=ier) 
    22511640    IF (ier /= 0) THEN 
    2252       WRITE(*,*) & 
    2253  &      'getin_allockeys : Can not allocate keyfromfile to size ', & 
    2254  &      keymemsize+memslabs 
    2255       STOP 
     1641      CALL ipslerr (3,'getin_allockeys', & 
     1642 &     'Can not allocate keyfromfile', & 
     1643 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
    22561644    ENDIF 
    22571645    keyfromfile(1:keymemsize) = tmp_int(1:keymemsize) 
    2258 !- 
     1646!--- 
    22591647    tmp_int(1:keymemsize) = keymemstart(1:keymemsize) 
    22601648    DEALLOCATE(keymemstart) 
    22611649    ALLOCATE(keymemstart(keymemsize+memslabs),stat=ier) 
    22621650    IF (ier /= 0) THEN 
    2263       WRITE(*,*) & 
    2264  &      'getin_allockeys : Can not allocate keymemstart to size ', & 
    2265  &      keymemsize+memslabs 
    2266       STOP 
     1651      CALL ipslerr (3,'getin_allockeys', & 
     1652 &     'Can not allocate keymemstart', & 
     1653 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
    22671654    ENDIF 
    22681655    keymemstart(1:keymemsize) = tmp_int(1:keymemsize) 
    2269 !- 
     1656!--- 
    22701657    tmp_int(1:keymemsize) = keymemlen(1:keymemsize) 
    22711658    DEALLOCATE(keymemlen) 
    22721659    ALLOCATE(keymemlen(keymemsize+memslabs),stat=ier) 
    22731660    IF (ier /= 0) THEN 
    2274       WRITE(*,*) & 
    2275  &      'getin_allockeys : Can not allocate keymemlen to size ', & 
    2276  &      keymemsize+memslabs 
    2277       STOP 
     1661      CALL ipslerr (3,'getin_allockeys', & 
     1662 &     'Can not allocate keymemlen', & 
     1663 &     'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
    22781664    ENDIF 
    22791665    keymemlen(1:keymemsize) = tmp_int(1:keymemsize) 
    2280 !- 
     1666!--- 
    22811667    keymemsize = keymemsize+memslabs 
    2282 !- 
     1668!--- 
    22831669    DEALLOCATE(tmp_int) 
    22841670    DEALLOCATE(tmp_str) 
    … …  
    22921678!--------------------------------------------------------------------- 
    22931679!- Allocate the memory of the data base for all 4 types of memory 
    2294 !- 
    2295 !- 1 = INTEGER 
    2296 !- 2 = REAL 
    2297 !- 3 = CHAR 
    2298 !- 4 = LOGICAL 
    2299 !--------------------------------------------------------------------- 
    2300   IMPLICIT NONE 
    2301 !- 
    2302   INTEGER :: type, len_wanted 
     1680!- INTEGER / REAL / CHAR / LOGICAL 
     1681!--------------------------------------------------------------------- 
     1682  IMPLICIT NONE 
     1683!- 
     1684  INTEGER :: type,len_wanted 
    23031685!- 
    23041686  INTEGER,ALLOCATABLE :: tmp_int(:) 
    … …  
    23071689  LOGICAL,ALLOCATABLE :: tmp_logic(:) 
    23081690  INTEGER :: ier 
     1691  CHARACTER(LEN=20) :: c_tmp 
    23091692!--------------------------------------------------------------------- 
    23101693  SELECT CASE (type) 
    2311   CASE(1) 
    2312     IF (intmemsize == 0) THEN 
    2313       ALLOCATE(intmem(memslabs),stat=ier) 
     1694  CASE(k_i) 
     1695    IF (i_memsize == 0) THEN 
     1696      ALLOCATE(i_mem(memslabs),stat=ier) 
    23141697      IF (ier /= 0) THEN 
    2315         WRITE(*,*) & 
    2316  &    'getin_allocmem : Unable to allocate db-memory intmem to ', & 
    2317  &    memslabs 
    2318         STOP 
    2319       ENDIF 
    2320       intmemsize=memslabs 
     1698        WRITE (UNIT=c_tmp,FMT=*) memslabs 
     1699        CALL ipslerr (3,'getin_allocmem', & 
     1700 &       'Unable to allocate db-memory', & 
     1701 &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1702      ENDIF 
     1703      i_memsize=memslabs 
    23211704    ELSE 
    2322       ALLOCATE(tmp_int(intmemsize),stat=ier) 
     1705      ALLOCATE(tmp_int(i_memsize),stat=ier) 
    23231706      IF (ier /= 0) THEN 
    2324         WRITE(*,*) & 
    2325  &    'getin_allocmem : Unable to allocate tmp_int to ', & 
    2326  &    intmemsize 
    2327         STOP 
    2328       ENDIF 
    2329       tmp_int(1:intmemsize) = intmem(1:intmemsize) 
    2330       DEALLOCATE(intmem) 
    2331       ALLOCATE(intmem(intmemsize+MAX(memslabs,len_wanted)),stat=ier) 
     1707        WRITE (UNIT=c_tmp,FMT=*) i_memsize 
     1708        CALL ipslerr (3,'getin_allocmem', & 
     1709 &       'Unable to allocate tmp_int', & 
     1710 &       'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1711      ENDIF 
     1712      tmp_int(1:i_memsize) = i_mem(1:i_memsize) 
     1713      DEALLOCATE(i_mem) 
     1714      ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier) 
    23321715      IF (ier /= 0) THEN 
    2333         WRITE(*,*) & 
    2334  &    'getin_allocmem : Unable to re-allocate db-memory intmem to ', & 
    2335  &    intmemsize+MAX(memslabs,len_wanted) 
    2336         STOP 
    2337       ENDIF 
    2338       intmem(1:intmemsize) = tmp_int(1:intmemsize) 
    2339       intmemsize = intmemsize+MAX(memslabs,len_wanted) 
     1716        WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted) 
     1717        CALL ipslerr (3,'getin_allocmem', & 
     1718 &       'Unable to re-allocate db-memory', & 
     1719 &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1720      ENDIF 
     1721      i_mem(1:i_memsize) = tmp_int(1:i_memsize) 
     1722      i_memsize = i_memsize+MAX(memslabs,len_wanted) 
    23401723      DEALLOCATE(tmp_int) 
    23411724    ENDIF 
    2342   CASE(2) 
    2343     IF (realmemsize == 0) THEN 
    2344       ALLOCATE(realmem(memslabs),stat=ier) 
     1725  CASE(k_r) 
     1726    IF (r_memsize == 0) THEN 
     1727      ALLOCATE(r_mem(memslabs),stat=ier) 
    23451728      IF (ier /= 0) THEN 
    2346         WRITE(*,*) & 
    2347  &    'getin_allocmem : Unable to allocate db-memory realmem to ', & 
    2348  &    memslabs 
    2349         STOP 
    2350       ENDIF 
    2351       realmemsize =  memslabs 
     1729        WRITE (UNIT=c_tmp,FMT=*) memslabs 
     1730        CALL ipslerr (3,'getin_allocmem', & 
     1731 &       'Unable to allocate db-memory', & 
     1732 &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1733      ENDIF 
     1734      r_memsize =  memslabs 
    23521735    ELSE 
    2353       ALLOCATE(tmp_real(realmemsize),stat=ier) 
     1736      ALLOCATE(tmp_real(r_memsize),stat=ier) 
    23541737      IF (ier /= 0) THEN 
    2355         WRITE(*,*) & 
    2356  &    'getin_allocmem : Unable to allocate tmp_real to ', & 
    2357  &    realmemsize 
    2358         STOP 
    2359       ENDIF 
    2360       tmp_real(1:realmemsize) = realmem(1:realmemsize) 
    2361       DEALLOCATE(realmem) 
    2362       ALLOCATE(realmem(realmemsize+MAX(memslabs,len_wanted)),stat=ier) 
     1738        WRITE (UNIT=c_tmp,FMT=*) r_memsize 
     1739        CALL ipslerr (3,'getin_allocmem', & 
     1740 &       'Unable to allocate tmp_real', & 
     1741 &       'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1742      ENDIF 
     1743      tmp_real(1:r_memsize) = r_mem(1:r_memsize) 
     1744      DEALLOCATE(r_mem) 
     1745      ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier) 
    23631746      IF (ier /= 0) THEN 
    2364         WRITE(*,*) & 
    2365  &    'getin_allocmem : Unable to re-allocate db-memory realmem to ', & 
    2366  &    realmemsize+MAX(memslabs,len_wanted) 
    2367         STOP 
    2368       ENDIF 
    2369       realmem(1:realmemsize) = tmp_real(1:realmemsize) 
    2370       realmemsize = realmemsize+MAX(memslabs,len_wanted) 
     1747        WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted) 
     1748        CALL ipslerr (3,'getin_allocmem', & 
     1749 &       'Unable to re-allocate db-memory', & 
     1750 &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1751      ENDIF 
     1752      r_mem(1:r_memsize) = tmp_real(1:r_memsize) 
     1753      r_memsize = r_memsize+MAX(memslabs,len_wanted) 
    23711754      DEALLOCATE(tmp_real) 
    23721755    ENDIF 
    2373   CASE(3) 
    2374     IF (charmemsize == 0) THEN 
    2375       ALLOCATE(charmem(memslabs),stat=ier) 
     1756  CASE(k_c) 
     1757    IF (c_memsize == 0) THEN 
     1758      ALLOCATE(c_mem(memslabs),stat=ier) 
    23761759      IF (ier /= 0) THEN 
    2377         WRITE(*,*) & 
    2378  &    'getin_allocmem : Unable to allocate db-memory charmem to ', & 
    2379  &    memslabs 
    2380         STOP 
    2381       ENDIF 
    2382       charmemsize = memslabs 
     1760        WRITE (UNIT=c_tmp,FMT=*) memslabs 
     1761        CALL ipslerr (3,'getin_allocmem', & 
     1762 &       'Unable to allocate db-memory', & 
     1763 &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1764      ENDIF 
     1765      c_memsize = memslabs 
    23831766    ELSE 
    2384       ALLOCATE(tmp_char(charmemsize),stat=ier) 
     1767      ALLOCATE(tmp_char(c_memsize),stat=ier) 
    23851768      IF (ier /= 0) THEN 
    2386         WRITE(*,*) & 
    2387  &    'getin_allocmem : Unable to allocate tmp_char to ', & 
    2388  &    charmemsize 
    2389         STOP 
    2390       ENDIF 
    2391       tmp_char(1:charmemsize) = charmem(1:charmemsize) 
    2392       DEALLOCATE(charmem) 
    2393       ALLOCATE(charmem(charmemsize+MAX(memslabs,len_wanted)),stat=ier) 
     1769        WRITE (UNIT=c_tmp,FMT=*) c_memsize 
     1770        CALL ipslerr (3,'getin_allocmem', & 
     1771 &       'Unable to allocate tmp_char', & 
     1772 &       'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1773      ENDIF 
     1774      tmp_char(1:c_memsize) = c_mem(1:c_memsize) 
     1775      DEALLOCATE(c_mem) 
     1776      ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier) 
    23941777      IF (ier /= 0) THEN 
    2395         WRITE(*,*) & 
    2396  &    'getin_allocmem : Unable to re-allocate db-memory charmem to ', & 
    2397  &    charmemsize+MAX(memslabs,len_wanted) 
    2398         STOP 
    2399       ENDIF 
    2400       charmem(1:charmemsize) = tmp_char(1:charmemsize) 
    2401       charmemsize = charmemsize+MAX(memslabs,len_wanted) 
     1778        WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted) 
     1779        CALL ipslerr (3,'getin_allocmem', & 
     1780 &       'Unable to re-allocate db-memory', & 
     1781 &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1782      ENDIF 
     1783      c_mem(1:c_memsize) = tmp_char(1:c_memsize) 
     1784      c_memsize = c_memsize+MAX(memslabs,len_wanted) 
    24021785      DEALLOCATE(tmp_char) 
    24031786    ENDIF 
    2404   CASE(4) 
    2405     IF (logicmemsize == 0) THEN 
    2406       ALLOCATE(logicmem(memslabs),stat=ier) 
     1787  CASE(k_l) 
     1788    IF (l_memsize == 0) THEN 
     1789      ALLOCATE(l_mem(memslabs),stat=ier) 
    24071790      IF (ier /= 0) THEN 
    2408         WRITE(*,*) & 
    2409  &    'getin_allocmem : Unable to allocate db-memory logicmem to ', & 
    2410  &    memslabs 
    2411         STOP 
    2412       ENDIF 
    2413       logicmemsize = memslabs 
     1791        WRITE (UNIT=c_tmp,FMT=*) memslabs 
     1792        CALL ipslerr (3,'getin_allocmem', & 
     1793 &       'Unable to allocate db-memory', & 
     1794 &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1795      ENDIF 
     1796      l_memsize = memslabs 
    24141797    ELSE 
    2415       ALLOCATE(tmp_logic(logicmemsize),stat=ier) 
     1798      ALLOCATE(tmp_logic(l_memsize),stat=ier) 
    24161799      IF (ier /= 0) THEN 
    2417         WRITE(*,*) & 
    2418  &    'getin_allocmem : Unable to allocate tmp_logic to ', & 
    2419  &    logicmemsize 
    2420         STOP 
    2421       ENDIF 
    2422       tmp_logic(1:logicmemsize) = logicmem(1:logicmemsize) 
    2423       DEALLOCATE(logicmem) 
    2424       ALLOCATE(logicmem(logicmemsize+MAX(memslabs,len_wanted)),stat=ier) 
     1800        WRITE (UNIT=c_tmp,FMT=*) l_memsize 
     1801        CALL ipslerr (3,'getin_allocmem', & 
     1802 &       'Unable to allocate tmp_logic', & 
     1803 &       'to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1804      ENDIF 
     1805      tmp_logic(1:l_memsize) = l_mem(1:l_memsize) 
     1806      DEALLOCATE(l_mem) 
     1807      ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier) 
    24251808      IF (ier /= 0) THEN 
    2426         WRITE(*,*) & 
    2427  &    'getin_allocmem : Unable to re-allocate db-memory logicmem to ', & 
    2428  &    logicmemsize+MAX(memslabs,len_wanted) 
    2429         STOP 
    2430       ENDIF 
    2431       logicmem(1:logicmemsize) = tmp_logic(1:logicmemsize) 
    2432       logicmemsize = logicmemsize+MAX(memslabs,len_wanted) 
     1809        WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted) 
     1810        CALL ipslerr (3,'getin_allocmem', & 
     1811 &       'Unable to re-allocate db-memory', & 
     1812 &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ') 
     1813      ENDIF 
     1814      l_mem(1:l_memsize) = tmp_logic(1:l_memsize) 
     1815      l_memsize = l_memsize+MAX(memslabs,len_wanted) 
    24331816      DEALLOCATE(tmp_logic) 
    24341817    ENDIF 
    24351818  CASE DEFAULT 
    2436     WRITE(*,*) 'getin_allocmem : Unknown type : ',type 
    2437     STOP 
     1819    CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ') 
    24381820  END SELECT 
    24391821!---------------------------- 
    … …  
    24561838  CHARACTER(*),OPTIONAL :: fileprefix 
    24571839!- 
    2458   CHARACTER(LEN=80) :: usedfileprefix = "used" 
     1840  CHARACTER(LEN=80) :: usedfileprefix 
    24591841  INTEGER :: ikey,if,iff,iv 
    2460   CHARACTER(LEN=3) :: tmp3 
    2461   CHARACTER(LEN=100) :: tmp_str, used_filename 
     1842  CHARACTER(LEN=20) :: c_tmp 
     1843  CHARACTER(LEN=100) :: tmp_str,used_filename 
    24621844  LOGICAL :: check = .FALSE. 
    24631845!--------------------------------------------------------------------- 
    24641846  IF (PRESENT(fileprefix)) THEN 
    2465     usedfileprefix = fileprefix(1:MIN(len_trim(fileprefix),80)) 
     1847    usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80)) 
     1848  ELSE 
     1849    usedfileprefix = "used" 
    24661850  ENDIF 
    24671851!- 
    … …  
    24741858      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys 
    24751859    ENDIF 
    2476     OPEN(unit=76,file=used_filename) 
    2477 !- 
     1860    OPEN (UNIT=22,FILE=used_filename) 
     1861!--- 
    24781862!-- If this is the first file we need to add the list 
    24791863!-- of file which belong to it 
    2480 !- 
    2481     IF ( (if == 1) .AND. (nbfiles > 1) ) THEN 
    2482       WRITE(76,*) '# ' 
    2483       WRITE(76,*) '# This file is linked to the following files :' 
    2484       WRITE(76,*) '# ' 
     1864    IF ( (if == 1).AND.(nbfiles > 1) ) THEN 
     1865      WRITE(22,*) '# ' 
     1866      WRITE(22,*) '# This file is linked to the following files :' 
     1867      WRITE(22,*) '# ' 
    24851868      DO iff=2,nbfiles 
    2486         WRITE(76,*) 'INCLUDEDEF = ',TRIM(filelist(iff)) 
     1869        WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff)) 
    24871870      ENDDO 
    2488       WRITE(76,*) '# ' 
     1871      WRITE(22,*) '# ' 
    24891872    ENDIF 
    24901873!--- 
    24911874    DO ikey=1,nb_keys 
    2492 !- 
    2493 !---- Is this key form this file ? 
    2494 !- 
     1875!----- 
     1876!---- Is this key from this file ? 
    24951877      IF (keyfromfile(ikey) == if) THEN 
    2496 !- 
    2497 !---- Write some comments 
    2498 !- 
    2499         WRITE(76,*) '#' 
     1878!------- 
     1879!------ Write some comments 
     1880        WRITE(22,*) '#' 
    25001881        SELECT CASE (keystatus(ikey)) 
    25011882        CASE(1) 
    2502           WRITE(76,*) '# Values of ', & 
     1883          WRITE(22,*) '# Values of ', & 
    25031884 &          TRIM(keystr(ikey)),' comes from the run.def.' 
    25041885        CASE(2) 
    2505           WRITE(76,*) '# Values of ', & 
     1886          WRITE(22,*) '# Values of ', & 
    25061887 &          TRIM(keystr(ikey)),' are all defaults.' 
    25071888        CASE(3) 
    2508           WRITE(76,*) '# Values of ', & 
     1889          WRITE(22,*) '# Values of ', & 
    25091890 &          TRIM(keystr(ikey)),' are a mix of run.def and defaults.' 
    25101891        CASE DEFAULT 
    2511           WRITE(76,*) '# Dont know from where the value of ', & 
     1892          WRITE(22,*) '# Dont know from where the value of ', & 
    25121893 &          TRIM(keystr(ikey)),' comes.' 
    25131894        END SELECT 
    2514         WRITE(76,*) '#' 
    2515 !- 
    2516 !---- Write the values 
    2517 !- 
     1895        WRITE(22,*) '#' 
     1896!------- 
     1897!------ Write the values 
    25181898        SELECT CASE (keytype(ikey)) 
    2519 !- 
    2520         CASE(1) 
     1899        CASE(k_i) 
    25211900          IF (keymemlen(ikey) == 1) THEN 
    25221901            IF (keycompress(ikey) < 0) THEN 
    2523               WRITE(76,*) & 
    2524  &              TRIM(keystr(ikey)),' = ',intmem(keymemstart(ikey)) 
     1902              WRITE(22,*) & 
     1903 &              TRIM(keystr(ikey)),' = ',i_mem(keymemstart(ikey)) 
    25251904            ELSE 
    2526               WRITE(76,*) & 
     1905              WRITE(22,*) & 
    25271906 &              TRIM(keystr(ikey)),' = ',keycompress(ikey), & 
    2528  &              ' * ',intmem(keymemstart(ikey)) 
     1907 &              ' * ',i_mem(keymemstart(ikey)) 
    25291908            ENDIF 
    25301909          ELSE 
    25311910            DO iv=0,keymemlen(ikey)-1 
    2532               WRITE(tmp3,'(I3.3)') iv+1 
    2533               WRITE(76,*) & 
    2534  &              TRIM(keystr(ikey)),'__',tmp3, & 
    2535  &              ' = ',intmem(keymemstart(ikey)+iv) 
     1911              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1 
     1912              WRITE(22,*) & 
     1913 &              TRIM(keystr(ikey)),'__',TRIM(ADJUSTL(c_tmp)), & 
     1914 &              ' = ',i_mem(keymemstart(ikey)+iv) 
    25361915            ENDDO 
    25371916          ENDIF 
    2538 !- 
    2539         CASE(2) 
     1917        CASE(k_r) 
    25401918          IF (keymemlen(ikey) == 1) THEN 
    25411919            IF (keycompress(ikey) < 0) THEN 
    2542               WRITE(76,*) & 
    2543  &              TRIM(keystr(ikey)),' = ',realmem(keymemstart(ikey)) 
     1920              WRITE(22,*) & 
     1921 &              TRIM(keystr(ikey)),' = ',r_mem(keymemstart(ikey)) 
    25441922            ELSE 
    2545               WRITE(76,*) & 
     1923              WRITE(22,*) & 
    25461924 &              TRIM(keystr(ikey)),' = ',keycompress(ikey),& 
    2547                    & ' * ',realmem(keymemstart(ikey)) 
     1925                   & ' * ',r_mem(keymemstart(ikey)) 
    25481926            ENDIF 
    25491927          ELSE 
    25501928            DO iv=0,keymemlen(ikey)-1 
    2551               WRITE(tmp3,'(I3.3)') iv+1 
    2552               WRITE(76,*) & 
    2553  &              TRIM(keystr(ikey)),'__',tmp3, & 
    2554  &              ' = ',realmem(keymemstart(ikey)+iv) 
     1929              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1 
     1930              WRITE(22,*) & 
     1931 &              TRIM(keystr(ikey)),'__',TRIM(ADJUSTL(c_tmp)), & 
     1932 &              ' = ',r_mem(keymemstart(ikey)+iv) 
    25551933            ENDDO 
    25561934          ENDIF 
    2557         CASE(3) 
     1935        CASE(k_c) 
    25581936          IF (keymemlen(ikey) == 1) THEN 
    2559             tmp_str = charmem(keymemstart(ikey)) 
    2560             WRITE(76,*) TRIM(keystr(ikey)),' = ',TRIM(tmp_str) 
     1937            tmp_str = c_mem(keymemstart(ikey)) 
     1938            WRITE(22,*) TRIM(keystr(ikey)),' = ',TRIM(tmp_str) 
    25611939          ELSE 
    25621940            DO iv=0,keymemlen(ikey)-1 
    2563               WRITE(tmp3,'(I3.3)') iv+1 
    2564               tmp_str = charmem(keymemstart(ikey)+iv) 
    2565               WRITE(76,*) & 
    2566  &              TRIM(keystr(ikey)),'__',tmp3,' = ',TRIM(tmp_str) 
     1941              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1 
     1942              tmp_str = c_mem(keymemstart(ikey)+iv) 
     1943              WRITE(22,*) & 
     1944 &              TRIM(keystr(ikey)),'__',TRIM(ADJUSTL(c_tmp)), & 
     1945 &              ' = ',TRIM(tmp_str) 
    25671946            ENDDO 
    25681947          ENDIF 
    2569         CASE(4) 
     1948        CASE(k_l) 
    25701949          IF (keymemlen(ikey) == 1) THEN 
    2571             IF (logicmem(keymemstart(ikey))) THEN 
    2572               WRITE(76,*) TRIM(keystr(ikey)),' = TRUE ' 
     1950            IF (l_mem(keymemstart(ikey))) THEN 
     1951              WRITE(22,*) TRIM(keystr(ikey)),' = TRUE ' 
    25731952            ELSE 
    2574               WRITE(76,*) TRIM(keystr(ikey)),' = FALSE ' 
     1953              WRITE(22,*) TRIM(keystr(ikey)),' = FALSE ' 
    25751954            ENDIF 
    25761955          ELSE 
    25771956            DO iv=0,keymemlen(ikey)-1 
    2578               WRITE(tmp3,'(I3.3)') iv+1 
    2579               IF (logicmem(keymemstart(ikey)+iv)) THEN 
    2580                 WRITE(76,*) TRIM(keystr(ikey)),'__',tmp3,' = TRUE ' 
     1957              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1 
     1958              IF (l_mem(keymemstart(ikey)+iv)) THEN 
     1959                WRITE(22,*) TRIM(keystr(ikey)),'__', & 
     1960 &                          TRIM(ADJUSTL(c_tmp)),' = TRUE ' 
    25811961              ELSE 
    2582                 WRITE(76,*) TRIM(keystr(ikey)),'__',tmp3,' = FALSE ' 
     1962                WRITE(22,*) TRIM(keystr(ikey)),'__', & 
     1963 &                          TRIM(ADJUSTL(c_tmp)),' = FALSE ' 
    25831964              ENDIF 
    25841965            ENDDO 
    25851966          ENDIF 
    2586 !- 
    25871967        CASE DEFAULT 
    2588           WRITE(*,*) & 
    2589  &          'FATAL ERROR : Unknown type for variable ', & 
    2590  &          TRIM(keystr(ikey)) 
    2591           STOP 'getin_dump' 
     1968          CALL ipslerr (3,'getin_dump', & 
     1969 &         'Unknown type for variable '//TRIM(keystr(ikey)),' ',' ') 
    25921970        END SELECT 
    25931971      ENDIF 
    25941972    ENDDO 
    25951973!- 
    2596     CLOSE(unit=76) 
     1974    CLOSE(UNIT=22) 
    25971975!- 
    25981976  ENDDO 
    25991977!------------------------ 
    26001978END SUBROUTINE getin_dump 
    2601 !- 
    26021979!=== 
    2603 !- 
     1980SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v) 
     1981!--------------------------------------------------------------------- 
     1982!- Returns the type of the argument (mutually exclusive) 
     1983!--------------------------------------------------------------------- 
     1984  IMPLICIT NONE 
     1985!- 
     1986  INTEGER,INTENT(OUT) :: k_typ 
     1987  CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp 
     1988  INTEGER,DIMENSION(:),OPTIONAL          :: i_v 
     1989  REAL,DIMENSION(:),OPTIONAL             :: r_v 
     1990  LOGICAL,DIMENSION(:),OPTIONAL          :: l_v 
     1991  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v 
     1992!--------------------------------------------------------------------- 
     1993  k_typ = 0 
     1994  IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) & 
     1995 &    /= 1) THEN 
     1996    CALL ipslerr (3,'get_qtyp', & 
     1997 &   'Invalid number of optional arguments','(/= 1)',' ') 
     1998  ENDIF 
     1999!- 
     2000  IF     (PRESENT(i_v)) THEN 
     2001    k_typ = k_i 
     2002    c_vtyp = 'INTEGER' 
     2003  ELSEIF (PRESENT(r_v)) THEN 
     2004    k_typ = k_r 
     2005    c_vtyp = 'REAL' 
     2006  ELSEIF (PRESENT(c_v)) THEN 
     2007    k_typ = k_c 
     2008    c_vtyp = 'CHARACTER' 
     2009  ELSEIF (PRESENT(l_v)) THEN 
     2010    k_typ = k_l 
     2011    c_vtyp = 'LOGICAL' 
     2012  ENDIF 
     2013!---------------------- 
     2014END SUBROUTINE get_qtyp 
     2015!=== 
     2016!------------------ 
    26042017END MODULE getincom 

  • IOIPSL/trunk/src/histcom.f90

    • Property svn:keywords set to Id
    r4 r11  
    11MODULE histcom 
    22!- 
    3 !$Header: /home/ioipsl/CVSROOT/IOIPSL/src/histcom.f90,v 2.3 2005/10/10 08:02:57 adm Exp $ 
     3!$Id$ 
    44!- 
    55  USE netcdf 

  • IOIPSL/trunk/src/ioipsl.f90

    • Property svn:keywords set to Id
    r4 r11  
    1 !$Header: /home/ioipsl/CVSROOT/IOIPSL/src/ioipsl.f90,v 2.2 2005/10/10 08:02:57 adm Exp $ 
     1MODULE ioipsl 
    22! 
    3 MODULE ioipsl 
     3!$Id$ 
     4! 
    45  USE errioipsl  
    56  USE stringop 

  • IOIPSL/trunk/src/mathelp.f90

    • Property svn:keywords set to Id
    r4 r11  
    1 !$Header: /home/ioipsl/CVSROOT/IOIPSL/src/mathelp.f90,v 2.2 2005/03/31 07:38:00 adm Exp $ 
     1!$Id$ 
    22! 
    33MODULE mathelp 

  • IOIPSL/trunk/src/restcom.f90

    • Property svn:keywords set to Id
    r4 r11  
    11MODULE restcom 
    22!- 
    3 !$Header: /home/ioipsl/CVSROOT/IOIPSL/src/restcom.f90,v 2.5 2005/10/27 07:25:58 adm Exp $ 
     3!$Id$ 
    44!- 
    55USE netcdf 
Note: See TracChangeset for help on using the changeset viewer.