Ignore:
Timestamp:
12/16/19 14:33:26 (4 years ago)
Author:
jgipsl
Message:

Following changes have been done by A.Jornet/LSCE. No change is results and no change in usage have been seen. Some more error checking might stop the model for example if dimensions are not correct in call to histcom module.

Restcom:

  • Define a new var size length (20 to 100 )→ pbs found without no errors
  • Raise an error when var name is too long
  • Deallocate any buffer at the end of all restput/restcget calls → buffers only increase size. After loading/saving nothing is done with this memory

Histcom:

  • Raise an error if given history declared variables do not match with given dimensions from histwrite

getincom and stringop:

  • Enable any length character for the run.def → useful for long filepaths

flincom

  • Enable filenames longer than 80 chars to any
  • Deallocate buffers at the end of any flinget subroutine
File:
1 edited

Legend:

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

    r936 r4863  
    66! See IOIPSL/IOIPSL_License_CeCILL.txt 
    77!--------------------------------------------------------------------- 
     8CHARACTER(LEN=1), PARAMETER :: COMMENT_TAG = "#" ! Comment symbol 
     9 
    810CONTAINS 
    911!= 
     
    120122END SUBROUTINE nocomma 
    121123!=== 
     124SUBROUTINE nocomment (str) 
     125!--------------------------------------------------------------------- 
     126!- Delete comment part from a line 
     127! 
     128!- line: TIME_SKIP=1D   # skip one day 
     129! to 
     130!  line: TIME_SKIP=1D 
     131!--------------------------------------------------------------------- 
     132  IMPLICIT NONE 
     133!- 
     134  CHARACTER(LEN=*), INTENT(INOUT) :: str 
     135!- 
     136  INTEGER :: pos 
     137!--------------------------------------------------------------------- 
     138  pos = INDEX(str, COMMENT_TAG) 
     139  IF (pos > 0) THEN 
     140    IF (pos == 1) THEN 
     141      str="" 
     142    ELSE 
     143      str=TRIM(str(1:pos-1)) 
     144    ENDIF 
     145  ENDIF 
     146!--------------------- 
     147END SUBROUTINE nocomment 
     148!=== 
    122149SUBROUTINE strlowercase (str) 
    123150!--------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.