Changeset 1313 for IOIPSL


Ignore:
Timestamp:
02/21/11 15:08:02 (13 years ago)
Author:
mmaipsl
Message:

Replace check parameter for ipsldbg output to simplfy getincom debugging.
Add debug informations in some subroutines.
Change "target" variables for targetname because it is f90 special attribute.
Add test on run.def open.

File:
1 edited

Legend:

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

    r963 r1313  
    66! See IOIPSL/IOIPSL_License_CeCILL.txt 
    77!--------------------------------------------------------------------- 
    8 USE errioipsl, ONLY : ipslerr 
     8USE errioipsl, ONLY : ipslerr,ipsldbg 
    99USE stringop, & 
    1010 &   ONLY : nocomma,cmpblank,strlowercase 
     
    3535!! and if not we get it from the definition file. 
    3636!! 
    37 !! SUBROUTINE getin (target,ret_val) 
     37!! SUBROUTINE getin (targetname,ret_val) 
    3838!! 
    3939!! INPUT 
    4040!! 
    41 !! (C) target : Name of the variable 
     41!! (C) targetname : Name of the variable 
    4242!! 
    4343!! OUTPUT 
     
    9898! keystatus = 2 : Default value is used 
    9999! keystatus = 3 : Some vector elements were taken from default 
     100  INTEGER,PARAMETER :: nondefault=1, default=2, vectornondefault=3 
    100101!- 
    101102! keytype definition 
     
    150151!=== INTEGER INTERFACE 
    151152!- 
    152 SUBROUTINE getinis (target,ret_val) 
    153 !--------------------------------------------------------------------- 
    154   IMPLICIT NONE 
    155 !- 
    156   CHARACTER(LEN=*) :: target 
     153SUBROUTINE getinis (targetname,ret_val) 
     154!--------------------------------------------------------------------- 
     155  IMPLICIT NONE 
     156!- 
     157  CHARACTER(LEN=*) :: targetname 
    157158  INTEGER :: ret_val 
    158159!- 
    159160  INTEGER,DIMENSION(1) :: tmp_ret_val 
    160   INTEGER :: pos,status=0,fileorig 
    161 !--------------------------------------------------------------------- 
    162 !- 
    163 ! Do we have this target in our database ? 
    164 !- 
    165   CALL get_findkey (1,target,pos) 
     161  INTEGER :: pos,status=0,fileorig, size_of_in 
     162!--------------------------------------------------------------------- 
     163!- 
     164! Do we have this targetname in our database ? 
     165!- 
     166  CALL get_findkey (1,targetname,pos) 
    166167!- 
    167168  tmp_ret_val(1) = ret_val 
     169  size_of_in = SIZE(tmp_ret_val) 
     170   
    168171!- 
    169172  IF (pos < 0) THEN 
    170173!-- Get the information out of the file 
    171     CALL get_fil (target,status,fileorig,i_val=tmp_ret_val) 
     174    CALL get_fil (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val) 
    172175!-- Put the data into the database 
    173176    CALL get_wdb & 
    174  &   (target,status,fileorig,1,i_val=tmp_ret_val) 
     177 &   (targetname,status,fileorig,1,i_val=tmp_ret_val) 
    175178  ELSE 
    176179!-- Get the value out of the database 
    177     CALL get_rdb (pos,1,target,i_val=tmp_ret_val) 
     180    CALL get_rdb (pos,1,targetname,i_val=tmp_ret_val) 
    178181  ENDIF 
    179182  ret_val = tmp_ret_val(1) 
     
    181184END SUBROUTINE getinis 
    182185!=== 
    183 SUBROUTINE getini1d (target,ret_val) 
    184 !--------------------------------------------------------------------- 
    185   IMPLICIT NONE 
    186 !- 
    187   CHARACTER(LEN=*) :: target 
     186SUBROUTINE getini1d (targetname,ret_val) 
     187!--------------------------------------------------------------------- 
     188  IMPLICIT NONE 
     189!- 
     190  CHARACTER(LEN=*) :: targetname 
    188191  INTEGER,DIMENSION(:) :: ret_val 
    189192!- 
     
    193196!--------------------------------------------------------------------- 
    194197!- 
    195 ! Do we have this target in our database ? 
    196 !- 
    197   CALL get_findkey (1,target,pos) 
     198! Do we have this targetname in our database ? 
     199!- 
     200  CALL get_findkey (1,targetname,pos) 
    198201!- 
    199202  size_of_in = SIZE(ret_val) 
     
    209212  IF (pos < 0) THEN 
    210213!-- Get the information out of the file 
    211     CALL get_fil (target,status,fileorig,i_val=tmp_ret_val) 
     214    CALL get_fil (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val) 
    212215!-- Put the data into the database 
    213216    CALL get_wdb & 
    214  &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val) 
     217 &   (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val) 
    215218  ELSE 
    216219!-- Get the value out of the database 
    217     CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val) 
     220    CALL get_rdb (pos,size_of_in,targetname,i_val=tmp_ret_val) 
    218221  ENDIF 
    219222  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) 
     
    221224END SUBROUTINE getini1d 
    222225!=== 
    223 SUBROUTINE getini2d (target,ret_val) 
    224 !--------------------------------------------------------------------- 
    225   IMPLICIT NONE 
    226 !- 
    227   CHARACTER(LEN=*) :: target 
     226SUBROUTINE getini2d (targetname,ret_val) 
     227!--------------------------------------------------------------------- 
     228  IMPLICIT NONE 
     229!- 
     230  CHARACTER(LEN=*) :: targetname 
    228231  INTEGER,DIMENSION(:,:) :: ret_val 
    229232!- 
     
    234237!--------------------------------------------------------------------- 
    235238!- 
    236 ! Do we have this target in our database ? 
    237 !- 
    238   CALL get_findkey (1,target,pos) 
     239! Do we have this targetname in our database ? 
     240!- 
     241  CALL get_findkey (1,targetname,pos) 
    239242!- 
    240243  size_of_in = SIZE(ret_val) 
     
    259262  IF (pos < 0) THEN 
    260263!-- Get the information out of the file 
    261     CALL get_fil (target,status,fileorig,i_val=tmp_ret_val) 
     264    CALL get_fil (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val) 
    262265!-- Put the data into the database 
    263266    CALL get_wdb & 
    264  &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val) 
     267 &   (targetname,status,fileorig,size_of_in,i_val=tmp_ret_val) 
    265268  ELSE 
    266269!-- Get the value out of the database 
    267     CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val) 
     270    CALL get_rdb (pos,size_of_in,targetname,i_val=tmp_ret_val) 
    268271  ENDIF 
    269272!- 
     
    280283!=== REAL INTERFACE 
    281284!- 
    282 SUBROUTINE getinrs (target,ret_val) 
    283 !--------------------------------------------------------------------- 
    284   IMPLICIT NONE 
    285 !- 
    286   CHARACTER(LEN=*) :: target 
     285SUBROUTINE getinrs (targetname,ret_val) 
     286!--------------------------------------------------------------------- 
     287  IMPLICIT NONE 
     288!- 
     289  CHARACTER(LEN=*) :: targetname 
    287290  REAL :: ret_val 
    288291!- 
    289292  REAL,DIMENSION(1) :: tmp_ret_val 
    290   INTEGER :: pos,status=0,fileorig 
    291 !--------------------------------------------------------------------- 
    292 !- 
    293 ! Do we have this target in our database ? 
    294 !- 
    295   CALL get_findkey (1,target,pos) 
     293  INTEGER :: pos,status=0,fileorig, size_of_in 
     294!--------------------------------------------------------------------- 
     295!- 
     296! Do we have this targetname in our database ? 
     297!- 
     298  CALL get_findkey (1,targetname,pos) 
    296299!- 
    297300  tmp_ret_val(1) = ret_val 
     301  size_of_in = SIZE(tmp_ret_val) 
    298302!- 
    299303  IF (pos < 0) THEN 
    300304!-- Get the information out of the file 
    301     CALL get_fil (target,status,fileorig,r_val=tmp_ret_val) 
     305    CALL get_fil (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val) 
    302306!-- Put the data into the database 
    303307    CALL get_wdb & 
    304  &   (target,status,fileorig,1,r_val=tmp_ret_val) 
     308 &   (targetname,status,fileorig,1,r_val=tmp_ret_val) 
    305309  ELSE 
    306310!-- Get the value out of the database 
    307     CALL get_rdb (pos,1,target,r_val=tmp_ret_val) 
     311    CALL get_rdb (pos,1,targetname,r_val=tmp_ret_val) 
    308312  ENDIF 
    309313  ret_val = tmp_ret_val(1) 
     
    311315END SUBROUTINE getinrs 
    312316!=== 
    313 SUBROUTINE getinr1d (target,ret_val) 
    314 !--------------------------------------------------------------------- 
    315   IMPLICIT NONE 
    316 !- 
    317   CHARACTER(LEN=*) :: target 
     317SUBROUTINE getinr1d (targetname,ret_val) 
     318!--------------------------------------------------------------------- 
     319  IMPLICIT NONE 
     320!- 
     321  CHARACTER(LEN=*) :: targetname 
    318322  REAL,DIMENSION(:) :: ret_val 
    319323!- 
     
    323327!--------------------------------------------------------------------- 
    324328!- 
    325 ! Do we have this target in our database ? 
    326 !- 
    327   CALL get_findkey (1,target,pos) 
     329! Do we have this targetname in our database ? 
     330!- 
     331  CALL get_findkey (1,targetname,pos) 
    328332!- 
    329333  size_of_in = SIZE(ret_val) 
     
    339343  IF (pos < 0) THEN 
    340344!-- Get the information out of the file 
    341     CALL get_fil (target,status,fileorig,r_val=tmp_ret_val) 
     345    CALL get_fil (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val) 
    342346!-- Put the data into the database 
    343347    CALL get_wdb & 
    344  &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val) 
     348 &   (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val) 
    345349  ELSE 
    346350!-- Get the value out of the database 
    347     CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val) 
     351    CALL get_rdb (pos,size_of_in,targetname,r_val=tmp_ret_val) 
    348352  ENDIF 
    349353  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) 
     
    351355END SUBROUTINE getinr1d 
    352356!=== 
    353 SUBROUTINE getinr2d (target,ret_val) 
    354 !--------------------------------------------------------------------- 
    355   IMPLICIT NONE 
    356 !- 
    357   CHARACTER(LEN=*) :: target 
     357SUBROUTINE getinr2d (targetname,ret_val) 
     358!--------------------------------------------------------------------- 
     359  IMPLICIT NONE 
     360!- 
     361  CHARACTER(LEN=*) :: targetname 
    358362  REAL,DIMENSION(:,:) :: ret_val 
    359363!- 
     
    364368!--------------------------------------------------------------------- 
    365369!- 
    366 ! Do we have this target in our database ? 
    367 !- 
    368   CALL get_findkey (1,target,pos) 
     370! Do we have this targetname in our database ? 
     371!- 
     372  CALL get_findkey (1,targetname,pos) 
    369373!- 
    370374  size_of_in = SIZE(ret_val) 
     
    389393  IF (pos < 0) THEN 
    390394!-- Get the information out of the file 
    391     CALL get_fil (target,status,fileorig,r_val=tmp_ret_val) 
     395    CALL get_fil (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val) 
    392396!-- Put the data into the database 
    393397    CALL get_wdb & 
    394  &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val) 
     398 &   (targetname,status,fileorig,size_of_in,r_val=tmp_ret_val) 
    395399  ELSE 
    396400!-- Get the value out of the database 
    397     CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val) 
     401    CALL get_rdb (pos,size_of_in,targetname,r_val=tmp_ret_val) 
    398402  ENDIF 
    399403!- 
     
    410414!=== CHARACTER INTERFACE 
    411415!- 
    412 SUBROUTINE getincs (target,ret_val) 
    413 !--------------------------------------------------------------------- 
    414   IMPLICIT NONE 
    415 !- 
    416   CHARACTER(LEN=*) :: target 
     416SUBROUTINE getincs (targetname,ret_val) 
     417!--------------------------------------------------------------------- 
     418  IMPLICIT NONE 
     419!- 
     420  CHARACTER(LEN=*) :: targetname 
    417421  CHARACTER(LEN=*) :: ret_val 
    418422!- 
    419423  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val 
    420   INTEGER :: pos,status=0,fileorig 
    421 !--------------------------------------------------------------------- 
    422 !- 
    423 ! Do we have this target in our database ? 
    424 !- 
    425   CALL get_findkey (1,target,pos) 
     424  INTEGER :: pos,status=0,fileorig,size_of_in 
     425!--------------------------------------------------------------------- 
     426!- 
     427! Do we have this targetname in our database ? 
     428!- 
     429  CALL get_findkey (1,targetname,pos) 
    426430!- 
    427431  tmp_ret_val(1) = ret_val 
     432  size_of_in = SIZE(tmp_ret_val) 
    428433!- 
    429434  IF (pos < 0) THEN 
    430435!-- Get the information out of the file 
    431     CALL get_fil (target,status,fileorig,c_val=tmp_ret_val) 
     436    CALL get_fil (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val) 
    432437!-- Put the data into the database 
    433438    CALL get_wdb & 
    434  &   (target,status,fileorig,1,c_val=tmp_ret_val) 
     439 &   (targetname,status,fileorig,1,c_val=tmp_ret_val) 
    435440  ELSE 
    436441!-- Get the value out of the database 
    437     CALL get_rdb (pos,1,target,c_val=tmp_ret_val) 
     442    CALL get_rdb (pos,1,targetname,c_val=tmp_ret_val) 
    438443  ENDIF 
    439444  ret_val = tmp_ret_val(1) 
     
    441446END SUBROUTINE getincs 
    442447!=== 
    443 SUBROUTINE getinc1d (target,ret_val) 
    444 !--------------------------------------------------------------------- 
    445   IMPLICIT NONE 
    446 !- 
    447   CHARACTER(LEN=*) :: target 
     448SUBROUTINE getinc1d (targetname,ret_val) 
     449!--------------------------------------------------------------------- 
     450  IMPLICIT NONE 
     451!- 
     452  CHARACTER(LEN=*) :: targetname 
    448453  CHARACTER(LEN=*),DIMENSION(:) :: ret_val 
    449454!- 
     
    453458!--------------------------------------------------------------------- 
    454459!- 
    455 ! Do we have this target in our database ? 
    456 !- 
    457   CALL get_findkey (1,target,pos) 
     460! Do we have this targetname in our database ? 
     461!- 
     462  CALL get_findkey (1,targetname,pos) 
    458463!- 
    459464  size_of_in = SIZE(ret_val) 
     
    469474  IF (pos < 0) THEN 
    470475!-- Get the information out of the file 
    471     CALL get_fil (target,status,fileorig,c_val=tmp_ret_val) 
     476    CALL get_fil (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val) 
    472477!-- Put the data into the database 
    473478    CALL get_wdb & 
    474  &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val) 
     479 &   (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val) 
    475480  ELSE 
    476481!-- Get the value out of the database 
    477     CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val) 
     482    CALL get_rdb (pos,size_of_in,targetname,c_val=tmp_ret_val) 
    478483  ENDIF 
    479484  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) 
     
    481486END SUBROUTINE getinc1d 
    482487!=== 
    483 SUBROUTINE getinc2d (target,ret_val) 
    484 !--------------------------------------------------------------------- 
    485   IMPLICIT NONE 
    486 !- 
    487   CHARACTER(LEN=*) :: target 
     488SUBROUTINE getinc2d (targetname,ret_val) 
     489!--------------------------------------------------------------------- 
     490  IMPLICIT NONE 
     491!- 
     492  CHARACTER(LEN=*) :: targetname 
    488493  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val 
    489494!- 
     
    494499!--------------------------------------------------------------------- 
    495500!- 
    496 ! Do we have this target in our database ? 
    497 !- 
    498   CALL get_findkey (1,target,pos) 
     501! Do we have this targetname in our database ? 
     502!- 
     503  CALL get_findkey (1,targetname,pos) 
    499504!- 
    500505  size_of_in = SIZE(ret_val) 
     
    519524  IF (pos < 0) THEN 
    520525!-- Get the information out of the file 
    521     CALL get_fil (target,status,fileorig,c_val=tmp_ret_val) 
     526    CALL get_fil (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val) 
    522527!-- Put the data into the database 
    523528    CALL get_wdb & 
    524  &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val) 
     529 &   (targetname,status,fileorig,size_of_in,c_val=tmp_ret_val) 
    525530  ELSE 
    526531!-- Get the value out of the database 
    527     CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val) 
     532    CALL get_rdb (pos,size_of_in,targetname,c_val=tmp_ret_val) 
    528533  ENDIF 
    529534!- 
     
    540545!=== LOGICAL INTERFACE 
    541546!- 
    542 SUBROUTINE getinls (target,ret_val) 
    543 !--------------------------------------------------------------------- 
    544   IMPLICIT NONE 
    545 !- 
    546   CHARACTER(LEN=*) :: target 
     547SUBROUTINE getinls (targetname,ret_val) 
     548!--------------------------------------------------------------------- 
     549  IMPLICIT NONE 
     550!- 
     551  CHARACTER(LEN=*) :: targetname 
    547552  LOGICAL :: ret_val 
    548553!- 
    549554  LOGICAL,DIMENSION(1) :: tmp_ret_val 
    550   INTEGER :: pos,status=0,fileorig 
    551 !--------------------------------------------------------------------- 
    552 !- 
    553 ! Do we have this target in our database ? 
    554 !- 
    555   CALL get_findkey (1,target,pos) 
     555  INTEGER :: pos,status=0,fileorig,size_of_in 
     556!--------------------------------------------------------------------- 
     557!- 
     558! Do we have this targetname in our database ? 
     559!- 
     560  CALL get_findkey (1,targetname,pos) 
    556561!- 
    557562  tmp_ret_val(1) = ret_val 
     563  size_of_in = SIZE(tmp_ret_val) 
    558564!- 
    559565  IF (pos < 0) THEN 
    560566!-- Get the information out of the file 
    561     CALL get_fil (target,status,fileorig,l_val=tmp_ret_val) 
     567    CALL get_fil (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val) 
    562568!-- Put the data into the database 
    563569    CALL get_wdb & 
    564  &   (target,status,fileorig,1,l_val=tmp_ret_val) 
     570 &   (targetname,status,fileorig,1,l_val=tmp_ret_val) 
    565571  ELSE 
    566572!-- Get the value out of the database 
    567     CALL get_rdb (pos,1,target,l_val=tmp_ret_val) 
     573    CALL get_rdb (pos,1,targetname,l_val=tmp_ret_val) 
    568574  ENDIF 
    569575  ret_val = tmp_ret_val(1) 
     
    571577END SUBROUTINE getinls 
    572578!=== 
    573 SUBROUTINE getinl1d (target,ret_val) 
    574 !--------------------------------------------------------------------- 
    575   IMPLICIT NONE 
    576 !- 
    577   CHARACTER(LEN=*) :: target 
     579SUBROUTINE getinl1d (targetname,ret_val) 
     580!--------------------------------------------------------------------- 
     581  IMPLICIT NONE 
     582!- 
     583  CHARACTER(LEN=*) :: targetname 
    578584  LOGICAL,DIMENSION(:) :: ret_val 
    579585!- 
     
    583589!--------------------------------------------------------------------- 
    584590!- 
    585 ! Do we have this target in our database ? 
    586 !- 
    587   CALL get_findkey (1,target,pos) 
     591! Do we have this targetname in our database ? 
     592!- 
     593  CALL get_findkey (1,targetname,pos) 
    588594!- 
    589595  size_of_in = SIZE(ret_val) 
     
    599605  IF (pos < 0) THEN 
    600606!-- Get the information out of the file 
    601     CALL get_fil (target,status,fileorig,l_val=tmp_ret_val) 
     607    CALL get_fil (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val) 
    602608!-- Put the data into the database 
    603609    CALL get_wdb & 
    604  &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val) 
     610 &   (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val) 
    605611  ELSE 
    606612!-- Get the value out of the database 
    607     CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val) 
     613    CALL get_rdb (pos,size_of_in,targetname,l_val=tmp_ret_val) 
    608614  ENDIF 
    609615  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in) 
     
    611617END SUBROUTINE getinl1d 
    612618!=== 
    613 SUBROUTINE getinl2d (target,ret_val) 
    614 !--------------------------------------------------------------------- 
    615   IMPLICIT NONE 
    616 !- 
    617   CHARACTER(LEN=*) :: target 
     619SUBROUTINE getinl2d (targetname,ret_val) 
     620!--------------------------------------------------------------------- 
     621  IMPLICIT NONE 
     622!- 
     623  CHARACTER(LEN=*) :: targetname 
    618624  LOGICAL,DIMENSION(:,:) :: ret_val 
    619625!- 
     
    624630!--------------------------------------------------------------------- 
    625631!- 
    626 ! Do we have this target in our database ? 
    627 !- 
    628   CALL get_findkey (1,target,pos) 
     632! Do we have this targetname in our database ? 
     633!- 
     634  CALL get_findkey (1,targetname,pos) 
    629635!- 
    630636  size_of_in = SIZE(ret_val) 
     
    649655  IF (pos < 0) THEN 
    650656!-- Get the information out of the file 
    651     CALL get_fil (target,status,fileorig,l_val=tmp_ret_val) 
     657    CALL get_fil (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val) 
    652658!-- Put the data into the database 
    653659    CALL get_wdb & 
    654  &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val) 
     660 &   (targetname,status,fileorig,size_of_in,l_val=tmp_ret_val) 
    655661  ELSE 
    656662!-- Get the value out of the database 
    657     CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val) 
     663    CALL get_rdb (pos,size_of_in,targetname,l_val=tmp_ret_val) 
    658664  ENDIF 
    659665!- 
     
    670676!=== Generic file/database INTERFACE 
    671677!- 
    672 SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val) 
     678SUBROUTINE get_fil (targetname,status,fileorig,nb_to_ret,i_val,r_val,c_val,l_val) 
    673679!--------------------------------------------------------------------- 
    674680!- Subroutine that will extract from the file the values 
    675 !- attributed to the keyword target 
    676 !- 
    677 !- (C) target    : target for which we will look in the file 
     681!- attributed to the keyword targetname 
     682!- 
     683!- (C) targetname    : target for which we will look in the file 
    678684!- (I) status    : tells us from where we obtained the data 
    679685!- (I) fileorig  : index of the file from which the key comes 
     686!- (I) nb_to_ret : size of output vector 
    680687!- (I) i_val(:)  : INTEGER(nb_to_ret)   values 
    681688!- (R) r_val(:)  : REAL(nb_to_ret)      values 
     
    685692  IMPLICIT NONE 
    686693!- 
    687   CHARACTER(LEN=*) :: target 
    688   INTEGER,INTENT(OUT) :: status,fileorig 
     694  CHARACTER(LEN=*) :: targetname 
     695  INTEGER,INTENT(OUT) :: status,fileorig,nb_to_ret 
    689696  INTEGER,DIMENSION(:),OPTIONAL          :: i_val 
    690697  REAL,DIMENSION(:),OPTIONAL             :: r_val 
     
    692699  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val 
    693700!- 
    694   INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err 
     701  INTEGER :: k_typ,it,pos,len_str,status_cnt,io_err 
    695702  CHARACTER(LEN=n_d_fmt)  :: cnt 
    696703  CHARACTER(LEN=80) :: str_READ,str_READ_lower 
     
    702709  REAL    :: r_cmpval 
    703710  INTEGER :: ipos_tr,ipos_fl 
     711  LOGICAL :: l_dbg 
     712!--------------------------------------------------------------------- 
     713  CALL ipsldbg (old_status=l_dbg) 
    704714!--------------------------------------------------------------------- 
    705715!- 
    706716! Get the type of the argument 
    707717  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val) 
    708   SELECT CASE (k_typ) 
    709   CASE(k_i) 
    710     nb_to_ret = SIZE(i_val) 
    711   CASE(k_r) 
    712     nb_to_ret = SIZE(r_val) 
    713   CASE(k_c) 
    714     nb_to_ret = SIZE(c_val) 
    715   CASE(k_l) 
    716     nb_to_ret = SIZE(l_val) 
    717   CASE DEFAULT 
     718  IF ( (k_typ.NE.k_i) .AND. (k_typ.NE.k_r) .AND. (k_typ.NE.k_c) .AND. (k_typ.NE.k_l) ) THEN 
    718719    CALL ipslerr (3,'get_fil', & 
    719720 &   'Internal error','Unknown type of data',' ') 
    720   END SELECT 
     721  ENDIF 
    721722!- 
    722723! Read the file(s) 
     
    731732!--- 
    732733!-- First try the target as it is 
    733     CALL get_findkey (2,target,pos) 
     734    CALL get_findkey (2,targetname,pos) 
    734735!--- 
    735736!-- Another try 
     
    737738    IF (pos < 0) THEN 
    738739      WRITE(UNIT=cnt,FMT=c_i_fmt) it 
    739       CALL get_findkey (2,TRIM(target)//'__'//cnt,pos) 
     740      CALL get_findkey (2,TRIM(targetname)//'__'//cnt,pos) 
    740741    ENDIF 
    741742!--- 
     
    748749      found(it) = .TRUE. 
    749750      fileorig = fromfile(pos) 
     751      ! 
     752      IF (l_dbg) THEN 
     753         WRITE(*,*) & 
     754              &      'getin_fil : read key ',targetname,' from file ',fileorig,' has type ',k_typ 
     755      ENDIF 
    750756!----- 
    751757!---- DECODE 
     
    754760      str_READ_lower = str_READ 
    755761      CALL strlowercase (str_READ_lower) 
     762      IF (l_dbg) THEN 
     763         WRITE(*,*) & 
     764              &      '            value    ',str_READ_lower 
     765      ENDIF 
    756766!----- 
    757767      IF (    (TRIM(str_READ_lower) == 'def')     & 
     
    789799        IF (io_err /= 0) THEN 
    790800          CALL ipslerr (3,'get_fil', & 
    791  &         'Target '//TRIM(target), & 
     801 &         'Target '//TRIM(targetname), & 
    792802 &         'is not of '//TRIM(c_vtyp)//' type',' ') 
    793803        ENDIF 
     
    801811          IF (compline(pos) /= nb_to_ret) THEN 
    802812            CALL ipslerr (2,'get_fil', & 
    803  &           'For key '//TRIM(target)//' we have a compressed field', & 
     813 &           'For key '//TRIM(targetname)//' we have a compressed field', & 
    804814 &           'which does not have the right size.', & 
    805815 &           'We will try to fix that.') 
     
    837847! Now we set the status for what we found 
    838848  IF (def_beha) THEN 
    839     status = 2 
    840     WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target) 
     849    status = default 
     850    CALL ipslerr (1,'USING DEFAULT BEHAVIOUR FOR', & 
     851 &   TRIM(targetname),' ',' ') 
     852    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(targetname) 
    841853  ELSE 
    842854    status_cnt = 0 
     
    846858        IF      (status_cnt <= max_msgs) THEN 
    847859          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', & 
    848  &               ADVANCE='NO') TRIM(target) 
     860 &               ADVANCE='NO') TRIM(targetname) 
    849861          IF (nb_to_ret > 1) THEN 
    850862            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO') 
     
    868880!--- 
    869881    IF (status_cnt == 0) THEN 
    870       status = 1 
     882      status = nondefault 
    871883    ELSE IF (status_cnt == nb_to_ret) THEN 
    872       status = 2 
     884      status = default 
    873885    ELSE 
    874       status = 3 
     886      status = vectornondefault 
    875887    ENDIF 
    876888  ENDIF 
     
    880892END SUBROUTINE get_fil 
    881893!=== 
    882 SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val) 
     894SUBROUTINE get_rdb (pos,size_of_in,targetname,i_val,r_val,c_val,l_val) 
    883895!--------------------------------------------------------------------- 
    884896!- Read the required variable in the database 
     
    887899!- 
    888900  INTEGER :: pos,size_of_in 
    889   CHARACTER(LEN=*) :: target 
     901  CHARACTER(LEN=*) :: targetname 
    890902  INTEGER,DIMENSION(:),OPTIONAL          :: i_val 
    891903  REAL,DIMENSION(:),OPTIONAL             :: r_val 
     
    907919  IF (key_tab(pos)%keytype /= k_typ) THEN 
    908920    CALL ipslerr (3,'get_rdb', & 
    909  &   'Wrong data type for keyword '//TRIM(target), & 
     921 &   'Wrong data type for keyword '//TRIM(targetname), & 
    910922 &   '(NOT '//TRIM(c_vtyp)//')',' ') 
    911923  ENDIF 
     
    915927 &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN 
    916928      CALL ipslerr (3,'get_rdb', & 
    917  &     'Wrong compression length','for keyword '//TRIM(target),' ') 
     929 &     'Wrong compression length','for keyword '//TRIM(targetname),' ') 
    918930    ELSE 
    919931      SELECT CASE (k_typ) 
     
    927939    IF (key_tab(pos)%keymemlen /= size_of_in) THEN 
    928940      CALL ipslerr (3,'get_rdb', & 
    929  &     'Wrong array length','for keyword '//TRIM(target),' ') 
     941 &     'Wrong array length','for keyword '//TRIM(targetname),' ') 
    930942    ELSE 
    931943      k_beg = key_tab(pos)%keymemstart 
     
    947959!=== 
    948960SUBROUTINE get_wdb & 
    949  &  (target,status,fileorig,size_of_in, & 
     961 &  (targetname,status,fileorig,size_of_in, & 
    950962 &   i_val,r_val,c_val,l_val) 
    951963!--------------------------------------------------------------------- 
     
    954966  IMPLICIT NONE 
    955967!- 
    956   CHARACTER(LEN=*) :: target 
     968  CHARACTER(LEN=*) :: targetname 
    957969  INTEGER :: status,fileorig,size_of_in 
    958970  INTEGER,DIMENSION(:),OPTIONAL          :: i_val 
     
    965977  INTEGER :: k_mempos,k_memsize,k_beg,k_end 
    966978  LOGICAL :: l_cmp 
     979  LOGICAL :: l_dbg 
     980!--------------------------------------------------------------------- 
     981  CALL ipsldbg (old_status=l_dbg) 
    967982!--------------------------------------------------------------------- 
    968983!- 
     
    9991014! Fill out the items of the data base 
    10001015  nb_keys = nb_keys+1 
    1001   key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n)) 
     1016  key_tab(nb_keys)%keystr = targetname(1:MIN(LEN_TRIM(targetname),l_n)) 
    10021017  key_tab(nb_keys)%keystatus = status 
    10031018  key_tab(nb_keys)%keytype = k_typ 
     
    10111026    key_tab(nb_keys)%keymemlen = size_of_in 
    10121027  ENDIF 
     1028  IF (l_dbg) THEN 
     1029     WRITE(*,*) & 
     1030 &     "get_wdb : nb_keys ",nb_keys," key_tab keystr   ",key_tab(nb_keys)%keystr,& 
     1031 &                                       ",keystatus   ",key_tab(nb_keys)%keystatus,& 
     1032 &                                       ",keytype     ",key_tab(nb_keys)%keytype,& 
     1033 &                                       ",keycompress ",key_tab(nb_keys)%keycompress,& 
     1034 &                                       ",keyfromfile ",key_tab(nb_keys)%keyfromfile,& 
     1035 &                                       ",keymemstart ",key_tab(nb_keys)%keymemstart 
     1036  ENDIF 
     1037 
    10131038!- 
    10141039! Before writing the actual size lets see if we have the space 
     
    10861111!- 
    10871112  INTEGER :: eof,ptn,len_str,i,it,iund,io_err 
    1088   LOGICAL :: check = .FALSE. 
     1113  LOGICAL :: l_dbg 
     1114!--------------------------------------------------------------------- 
     1115  CALL ipsldbg (old_status=l_dbg) 
    10891116!--------------------------------------------------------------------- 
    10901117  eof = 0 
     
    10921119  nb_lastkey = 0 
    10931120!- 
    1094   IF (check) THEN 
     1121  IF (l_dbg) THEN 
    10951122    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current)) 
    10961123  ENDIF 
     
    11331160      CALL cmpblank (NEW_str) 
    11341161      NEW_str  = TRIM(ADJUSTL(NEW_str)) 
    1135       IF (check) THEN 
     1162      IF (l_dbg) THEN 
    11361163        WRITE(*,*) & 
    11371164 &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str) 
     
    11711198!---- If we have an empty line then the keyword finishes 
    11721199      nb_lastkey = 0 
    1173       IF (check) THEN 
     1200      IF (l_dbg) THEN 
    11741201        WRITE(*,*) 'getin_readdef : Have found an emtpy line ' 
    11751202      ENDIF 
     
    11791206  CLOSE(UNIT=22) 
    11801207!- 
    1181   IF (check) THEN 
     1208  IF (l_dbg) THEN 
    11821209    OPEN (UNIT=22,file=TRIM(def_file)//'.test') 
    11831210    DO i=1,nb_lines 
     
    11861213    CLOSE(UNIT=22) 
    11871214  ENDIF 
     1215!- 
     1216  IF (l_dbg) THEN 
     1217     WRITE(*,*) "nb_lines ",nb_lines,"nb_keys ",nb_keys 
     1218     WRITE(*,*) "fichier ",fichier(1:nb_lines) 
     1219     WRITE(*,*) "targetlist ",targetlist(1:nb_lines) 
     1220     WRITE(*,*) "fromfile ",fromfile(1:nb_lines) 
     1221     WRITE(*,*) "compline ",compline(1:nb_lines) 
     1222    WRITE(*,*) '<-getin_readdef' 
     1223  ENDIF 
    11881224!--------------------------- 
    11891225END SUBROUTINE getin_readdef 
     
    12101246  CHARACTER(LEN=n_d_fmt) :: cnt 
    12111247  CHARACTER(LEN=10) :: c_fmt 
     1248  LOGICAL :: l_dbg 
     1249!--------------------------------------------------------------------- 
     1250  CALL ipsldbg (old_status=l_dbg) 
    12121251!--------------------------------------------------------------------- 
    12131252  len_str = LEN_TRIM(NEW_str) 
     
    13651404!- 
    13661405  ENDIF 
     1406 
     1407  IF (l_dbg) THEN 
     1408     WRITE(*,*) "getin_decrypt ->",TRIM(NEW_str), " : ", & 
     1409          & TRIM(fichier(nb_lines)), & 
     1410          & fromfile(nb_lines), & 
     1411          & TRIM(filelist(fromfile(nb_lines))) 
     1412     WRITE(*,*) "                compline : ",compline(nb_lines) 
     1413     WRITE(*,*) "                targetlist : ",TRIM(targetlist(nb_lines)) 
     1414     WRITE(*,*) "                last_key : ",last_key 
     1415  ENDIF 
    13671416!--------------------------- 
    13681417END SUBROUTINE getin_decrypt 
     
    14021451      WRITE(*,*) & 
    14031452 &  'getin_checkcohe : We will keep only the last value' 
     1453       CALL ipslerr (2,'getin_checkcohe','Found a problem on key ', & 
     1454 &                     TRIM(targetlist(line)), fichier(line)//" "//fichier(k)) 
    14041455      targetlist(line) = ' ' 
    14051456    ENDIF 
     
    17781829  CHARACTER(LEN=80) :: usedfileprefix 
    17791830  INTEGER :: ikey,if,iff,iv 
     1831  INTEGER :: ios 
    17801832  CHARACTER(LEN=20) :: c_tmp 
    17811833  CHARACTER(LEN=100) :: tmp_str,used_filename 
    1782   LOGICAL :: check = .FALSE. 
     1834  INTEGER :: io_err 
     1835  LOGICAL :: l_dbg 
     1836!--------------------------------------------------------------------- 
     1837  CALL ipsldbg (old_status=l_dbg) 
    17831838!--------------------------------------------------------------------- 
    17841839  IF (PRESENT(fileprefix)) THEN 
     
    17911846!--- 
    17921847    used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if)) 
    1793     IF (check) THEN 
     1848    IF (l_dbg) THEN 
    17941849      WRITE(*,*) & 
    1795  &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if 
     1850 &      'getin_dump : opens file : ',TRIM(used_filename),' if = ',if 
    17961851      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys 
    17971852    ENDIF 
    1798     OPEN (UNIT=22,FILE=used_filename) 
     1853    OPEN (UNIT=22,FILE=used_filename,iostat=io_err) 
     1854    IF (io_err /= 0) THEN 
     1855       CALL ipslerr (3,'getin_dump', & 
     1856            &   'Could not open file :',TRIM(used_filename), & 
     1857            &   '') 
     1858    ENDIF 
    17991859!--- 
    18001860!-- If this is the first file we need to add the list 
     
    18081868      ENDDO 
    18091869      WRITE(22,*) '# ' 
     1870      IF (l_dbg) THEN 
     1871         WRITE(*,*) '# ' 
     1872         WRITE(*,*) '# This file is linked to the following files :' 
     1873         WRITE(*,*) '# ' 
     1874         DO iff=2,nbfiles 
     1875            WRITE(*,*) 'INCLUDEDEF = ',TRIM(filelist(iff)) 
     1876         ENDDO 
     1877         WRITE(*,*) '# ' 
     1878      ENDIF 
    18101879    ENDIF 
    18111880!--- 
     
    18181887        WRITE(22,*) '#' 
    18191888        SELECT CASE (key_tab(ikey)%keystatus) 
    1820         CASE(1) 
     1889        CASE(nondefault) 
    18211890          WRITE(22,*) '# Values of ', & 
    18221891 &          TRIM(key_tab(ikey)%keystr),' comes from ',TRIM(def_file) 
    1823         CASE(2) 
     1892        CASE(default) 
    18241893          WRITE(22,*) '# Values of ', & 
    18251894 &          TRIM(key_tab(ikey)%keystr),' are all defaults.' 
    1826         CASE(3) 
     1895        CASE(vectornondefault) 
    18271896          WRITE(22,*) '# Values of ', & 
    18281897 &          TRIM(key_tab(ikey)%keystr), & 
     
    18331902        END SELECT 
    18341903        WRITE(22,*) '#' 
     1904        !- 
     1905        IF (l_dbg) THEN 
     1906           WRITE(*,*) '#' 
     1907           WRITE(*,*) '# Status of key ', ikey, ' : ',& 
     1908 &          TRIM(key_tab(ikey)%keystr),key_tab(ikey)%keystatus 
     1909        ENDIF 
    18351910!------- 
    18361911!------ Write the values 
Note: See TracChangeset for help on using the changeset viewer.