Changeset 1814 for trunk/LMDZ.TITAN/libf

Timestamp:

Oct 30, 2017, 11:04:45 AM (7 years ago)

Author:

jvatant

Message:

Correct string management within muphy for ifort
JVO

Location:

trunk/LMDZ.TITAN/libf

Files:

• muphytitan/argparse.F90 (modified) (2 diffs)
• muphytitan/cfgparse.F90 (modified) (5 diffs)
• muphytitan/errors.F90 (modified) (3 diffs)
• muphytitan/mm_globals.f90 (modified) (1 diff)
• muphytitan/strings.F90 (modified) (5 diffs)
• phytitan/tracer_h.F90 (modified) (1 diff)

trunk/LMDZ.TITAN/libf/muphytitan/argparse.F90

@@ -2065 +2065 @@
     !! @warning 
     !! On error, the status of `values` is undefined.
-    OBJECT(argparser), INTENT(in)                            :: this
-      !! An argparser object reference
-    CHARACTER(len=*), INTENT(out), ALLOCATABLE, DIMENSION(:) :: values
+    OBJECT(argparser), INTENT(in)                                  :: this
+      !! An argparser object reference
+    CHARACTER(len=st_slen), INTENT(out), ALLOCATABLE, DIMENSION(:) :: values
       !! An allocatable vector of **assumed length** strings with the value(s) of all 
       !! positionals arguments found. 
@@ -2779 +2779 @@
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` status is undefined.
-    TYPE(argc), INTENT(in)                                   :: this
+    TYPE(argc), INTENT(in)                                         :: this
       !! Argc object
-    CHARACTER(len=*), INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
+    CHARACTER(len=st_slen), INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
       !! Output values
     TYPE(error) :: ret

trunk/LMDZ.TITAN/libf/muphytitan/cfgparse.F90

@@ -803 +803 @@
     IF (LEN_TRIM(zsname) == 0 ) zsname = "__default__"
     fname = zsname//"/"//str_to_lower(TRIM(pname))
-    !print*,"DEBUG6: ",fname
     IF (.NOT.cfg_check_name(fname)) THEN
        err = error("Invalid option (no name)",-9)
@@ -872 +871 @@
       ! no options yet -> allocate
       ALLOCATE(this%options(1))
-      !this%options(1) = sca
-      !this%options(1)%name = pname
-      !this%options(1)%section = zsname
-      !this%options(1)%values = values
     ELSE
       ! parser has options: increase this%options size (ugly copy).
@@ -890 +885 @@
       ENDDO
       DEALLOCATE(tmp)
-      !this%options(no+1) = sca
-      !this%options(no+1)%name = pname
-      !this%options(no+1)%section = zsname
-      !this%options(no+1)%values = values
     ENDIF
     ! always add the option at the end.
-    !print*, words_length(this%options(no+1)%values)
     this%options(no+1) = sca
     CALL op_clear(sca)
@@ -1839 +1829 @@
              EXIT
            ENDIF
-           !print*,"DEBUG0: New section ",TRIM(name), " <- ",isec
            isec = TRIM(name)
          CASE(cfg_OPTION)
@@ -1849 +1838 @@
            ! 4. update curval
            IF (op_valid(curopt)) THEN 
-              !print*,"DEBUG3: new opt: ",TRIM(isec)//"/"//TRIM(name)," <- ",op_full_name(curopt)
               IF (LEN(curval) > 0) &
               CALL words_extend(curopt%values,TRIM(ADJUSTL(curval)),space,.true.,.true.)

trunk/LMDZ.TITAN/libf/muphytitan/errors.F90

@@ -84 +84 @@
     CONTAINS
       PROCEDURE, PUBLIC :: to_string => error_to_string
-        !! Get a string representation of the error
-!#if HAVE_FTNDTIO
-!      PROCEDURE, PRIVATE :: e_write_wfm
-!      PROCEDURE, PRIVATE :: e_write_wofm
-!      GENERIC, PUBLIC :: write(formatted) => e_write_wfm 
-!        !! Generic formatted write statement subroutine interface
-!      GENERIC, PUBLIC :: write(unformatted) => e_write_wofm
-!        !! Generic unformatted write statement subroutine interface
-!#endif
 #endif
   END TYPE error
@@ -201 +192 @@
   END FUNCTION error_to_string
 
-!#if HAVE_FTNDTIO
-!  SUBROUTINE e_write_wfm(dtv,unit,iotype,v_list,iostat,iomsg)
-!    !> Error derived type formatted IO write statement subroutine
-!    !!
-!    !! The method quietly ignores the derived type edit descriptor as the
-!    !! purpose of the subroutine is only to print a string. The edit descriptor
-!    !! used here is simply '(a)'.
-!    CLASS(error), INTENT(in)         :: dtv
-!      !! A reference to the string object 
-!    INTEGER, INTENT(in)              :: unit
-!      !! Logical unit where to print the object
-!    CHARACTER (len=*), INTENT(in)    :: iotype
-!      !! Type of IO
-!    INTEGER, INTENT(in)              :: v_list(:)
-!      !! List of value from edit descriptor 
-!    INTEGER, INTENT(out)             :: iostat
-!      !! Error status code (set to 2 if dtv's value if not allocated)
-!    CHARACTER (len=*), INTENT(inout) :: iomsg
-!      !! Error message 
-!    CHARACTER(len=15) :: i2s
-!    iostat = 0 ; iomsg = "" 
-!    WRITE(i2s,'(I15)') dtv%id ; i2s=ADJUSTL(i2s)
-!    WRITE(unit, '(a)') 'error('//TRIM(i2s)//'): '//TRIM(dtv%msg)
-!  END SUBROUTINE e_write_wfm
-!
-!  SUBROUTINE e_write_wofm(dtv, unit, iostat, iomsg)
-!    !! Error type IO unformatted write statement subroutine
-!    CLASS(error), INTENT(in)         :: dtv
-!      !! A reference to the string object 
-!    INTEGER, INTENT(in)              :: unit
-!      !! Logical unit where to print the object
-!    INTEGER, INTENT(out)             :: iostat
-!      !! Error status code (set to 2 if dtv's value if not allocated)
-!    CHARACTER (len=*), INTENT(inout) :: iomsg
-!      !! Error message 
-!    CHARACTER(len=15) :: i2s
-!    iostat = 0 ; iomsg = "" 
-!    WRITE(i2s,'(I15)') dtv%id ; i2s=ADJUSTL(i2s)
-!    WRITE(unit, '(a)') 'error('//TRIM(i2s)//'): '//TRIM(dtv%msg)
-!  END SUBROUTINE e_write_wofm
-!#endif
-
   SUBROUTINE aborting(err)
     !! Abort the program with specific exit code
@@ -252 +201 @@
     IF (err /= 0) THEN
       WRITE(*,'(a)') error_to_string(err)
-      CALL EXIT(err%id)
+      CALL EXIT(abs(err%id))
     ENDIF
   END SUBROUTINE aborting

trunk/LMDZ.TITAN/libf/muphytitan/mm_globals.f90

@@ -1438 +1438 @@
 
 END MODULE MM_GLOBALS
-

trunk/LMDZ.TITAN/libf/muphytitan/strings.F90

@@ -219 +219 @@
     !!
     !! @warning 
-    !! It is always limited to strings::st_slen characters.
+    !! It is always limited to [[strings(module):st_slen(variable)]] characters.
     CHARACTER(len=st_slen)        :: value = ''
 #endif
@@ -849 +849 @@
     !!
     !! The method attempts to convert the list of words in a vector of strings.
-    !! If _this_ list of words is empty the output vector is allocated with 0 elements and the method returns
-    !! .false.. Otherwise it returns .true.
+    !! If _this_ list of words is empty, the output vector is allocated with 0 elements and the method returns
+    !! .false., otherwise it returns .true.
     !! @note
-    !! If the size of the output string vector (i.e. the character length of the string elements within the
-    !! vector) is too small, words can be truncated.
+    !! If elements in __this__ words object are wider than [[strings(module):st_slen(variable)]], output 
+    !! values will be truncated.
     OBJECT(words), INTENT(in)                                      :: this
       !! A words object reference
@@ -1041 +1041 @@
     !! Quotes are removed only if they are the first and last non blank
     !! characters. Either double and single quotes are stripped without distinction.
-    !! The output string is trimmed from leading and trailing blank spaces
+    !! The output string is trimmed from leading and trailing blank spaces (after quotes removal !)
     CHARACTER(len=*), INTENT(in)  :: str  !! A string to check
     CHARACTER(len=:), ALLOCATABLE :: ostr !! A string without external quotes (if any).  
@@ -1053 +1053 @@
     IF (i /= 1) i = 0
     IF (j /= LEN(ostr)) j = LEN(ostr)+1
-    ostr = ostr(i+1:j-1)
+    ostr = TRIM(ostr(i+1:j-1))
     RETURN
   END FUNCTION remove_quotes
@@ -1624 +1624 @@
     !! The function removes list of csi (ANSI escape sequences) from the given 
     !! string and returns a copy of it.
-    !! @note
-    !! This method does not update @lerror.
     CHARACTER(len=*), INTENT(in)      :: string
       !! Input string 

trunk/LMDZ.TITAN/libf/phytitan/tracer_h.F90

@@ -288 +288 @@
     DO i=1,size(indexes)
       idx = indexes(i)
-      IF (idx < 1 .OR. idx >= nt) THEN
+      IF (idx < 1 .OR. idx > nt) THEN
         ! WRITE(*,'((a),I3,(a),I3,(a))') "index out of range (",idx,"/",nt,")"
         CYCLE