Changeset bd2278d for redstr.f


Ignore:
Timestamp:
09/05/08 11:49:42 (16 years ago)
Author:
baerbaer <baerbaer@…>
Branches:
master
Children:
fafe4d6
Parents:
2ebb8b6
Message:

Reformatting comments and continuation marks.

Fortran 90 and higher use ! to mark comments no matter where they are in the
code. The only valid continuation marker is &.
I also added the SMMP.kdevelop.filelist to the repository to make it easier
to use kdevelop.

git-svn-id: ​svn+ssh://svn.berlios.de/svnroot/repos/smmp/trunk@12 26dc1dd8-5c4e-0410-9ffe-d298b4865968

File:
1 edited

Legend:

Unmodified
Added
Removed

  • redstr.f

    r2ebb8b6 rbd2278d  
    1 c**************************************************************
    2 c
    3 c This file contains the subroutines: extstr,ibegst,iendst,
    4 c                                     iredin,iredrl,iopfil,
    5 c                                     tolost,toupst
    6 c
    7 c Copyright 2003-2005  Frank Eisenmenger, U.H.E. Hansmann,
    8 c                      Shura Hayryan, Chin-Ku
    9 c Copyright 2007       Frank Eisenmenger, U.H.E. Hansmann,
    10 c                      Jan H. Meinke, Sandipan Mohanty
    11 c
    12 c **************************************************************
     1!**************************************************************
     2!
     3! This file contains the subroutines: extstr,ibegst,iendst,
     4!                                     iredin,iredrl,iopfil,
     5!                                     tolost,toupst
     6!
     7! Copyright 2003-2005  Frank Eisenmenger, U.H.E. Hansmann,
     8!                      Shura Hayryan, Chin-Ku
     9! Copyright 2007       Frank Eisenmenger, U.H.E. Hansmann,
     10!                      Jan H. Meinke, Sandipan Mohanty
     11!
     12! **************************************************************
    1313
    1414
    1515      subroutine extstr(spr,ib,ie,str,strn,l)
    1616
    17 c ..........................................................
    18 c PURPOSE:  Extract substring preceeding separator 'spr'
    19 c           from 'str' searching from position 'ib' up to
    20 c           position 'ie' and put it into 'strn(1:l)'.
    21 c           'ib' is shifted to position following 'spr' or
    22 c           to 'ie+1', if 'spr' is not found
    23 c
    24 c          ! 'spr' should not be blank
    25 c
    26 c CALLS: ibegst,iendst
    27 c ..........................................................
     17! ..........................................................
     18! PURPOSE:  Extract substring preceeding separator 'spr'
     19!           from 'str' searching from position 'ib' up to
     20!           position 'ie' and put it into 'strn(1:l)'.
     21!           'ib' is shifted to position following 'spr' or
     22!           to 'ie+1', if 'spr' is not found
     23!
     24!          ! 'spr' should not be blank
     25!
     26! CALLS: ibegst,iendst
     27! ..........................................................
    2828
    2929      implicit integer*4 (i-n)
    … …  
    6464        l=0
    6565        strn=blnk
    66 c ____________________________ make string in 'strn' left justified
     66! ____________________________ make string in 'strn' left justified
    6767      elseif (i.gt.1) then
    6868        j=iendst(strn)
    … …  
    7575
    7676      return
    77 c ______________________________________________________________ Error
     77! ______________________________________________________________ Error
    7878    1 write (*,'(a)') ' extstr> Substring to be extracted is too long !'
    7979      stop
    8080
    8181      end
    82 c **********************************
     82! **********************************
    8383      integer*4 function ibegst(str)
    8484
    85 c .............................................................
    86 c PURPOSE: returns position of 1st non-blank character in 'str'
    87 c
    88 c CALLS: none
    89 c
    90 c .............................................................
     85! .............................................................
     86! PURPOSE: returns position of 1st non-blank character in 'str'
     87!
     88! CALLS: none
     89!
     90! .............................................................
    9191
    9292      implicit integer*4 (i-n)
    … …  
    106106      return
    107107      end
    108 c **********************************
     108! **********************************
    109109      integer*4 function iendst(str)
    110110
    111 c ..............................................................
    112 c PURPOSE: returns position of last non-blank character in 'str'
    113 c
    114 c CALLS: none
    115 c
    116 c ..............................................................
     111! ..............................................................
     112! PURPOSE: returns position of last non-blank character in 'str'
     113!
     114! CALLS: none
     115!
     116! ..............................................................
    117117
    118118      implicit integer*4 (i-n)
    … …  
    132132      return
    133133      end
    134 c **************************************
     134! **************************************
    135135      integer*4 function iredin(line,in)
    136136
    137 c ..........................................
    138 c PURPOSE: Read integer*4 value 'in' from 'line'
    139 c          with format 'i9'
    140 c
    141 c          iredin=0 : error status
    142 c          iredin=1 : success
    143 c
    144 c CALLS: ibegst,iendst
    145 c ..........................................
     137! ..........................................
     138! PURPOSE: Read integer*4 value 'in' from 'line'
     139!          with format 'i9'
     140!
     141!          iredin=0 : error status
     142!          iredin=1 : success
     143!
     144! CALLS: ibegst,iendst
     145! ..........................................
    146146
    147147      implicit integer*4 (i-n)
    … …  
    172172    1 return
    173173      end
    174 c *************************************
     174! *************************************
    175175      integer*4 function iredrl(line,r)
    176176
    177 c ..........................................
    178 c PURPOSE: Read real*8 value 'r' from 'line'
    179 c          with format 'd17.6'
    180 c
    181 c          iredrl=0 : error status
    182 c          iredrl=1 : success
    183 c
    184 c CALLS: ibegst,iendst
    185 c ..........................................
     177! ..........................................
     178! PURPOSE: Read real*8 value 'r' from 'line'
     179!          with format 'd17.6'
     180!
     181!          iredrl=0 : error status
     182!          iredrl=1 : success
     183!
     184! CALLS: ibegst,iendst
     185! ..........................................
    186186
    187187      implicit integer*4 (i-n)
    188188
    189189      parameter (mxd =17,   ! max. # of digits
    190      #           mxap= 6,   ! max. # of digits after period
    191      #           mxip=mxd-mxap)
     190     &           mxap= 6,   ! max. # of digits after period
     191     &           mxip=mxd-mxap)
    192192 
    193193      real*8 r
    … …  
    222222    1 return
    223223      end
    224 c **************************
     224! **************************
    225225      subroutine tolost(str)
    226226
    227 c ..........................................
    228 c  PURPOSE:  converts 'string' to lower-case
    229 c  INPUT:    str - string to be converted
    230 c  CALLS:    ibegst,iendst
    231 c ..........................................
     227! ..........................................
     228!  PURPOSE:  converts 'string' to lower-case
     229!  INPUT:    str - string to be converted
     230!  CALLS:    ibegst,iendst
     231! ..........................................
    232232
    233233      include 'INCL.H'
    … …  
    246246      return
    247247      end
    248 c **************************
     248! **************************
    249249      subroutine toupst(str)
    250250
    251 c ..........................................
    252 c  PURPOSE:  converts 'string' to upper-case
    253 c  INPUT:    str - string to be converted
    254 c  CALLS:    ibegst,iendst
    255 c ..........................................
     251! ..........................................
     252!  PURPOSE:  converts 'string' to upper-case
     253!  INPUT:    str - string to be converted
     254!  CALLS:    ibegst,iendst
     255! ..........................................
    256256
    257257      include 'INCL.H'
    … …  
    270270      return
    271271      end
    272 c *****************************************************
     272! *****************************************************
    273273      integer*4 function iopfil(lun,filnam,stat,format)
    274274
    275 c ........................................................
    276 c PURPOSE: open 'lun' with 'filnam' 'stat' 'format'
    277 c
    278 c          returns: 1 = file successful opened
    279 c                   0 = error during open of existing file
    280 c                  -1 = file does not exist
    281 c
    282 c CALLS: ibegst
    283 c ........................................................
     275! ........................................................
     276! PURPOSE: open 'lun' with 'filnam' 'stat' 'format'
     277!
     278!          returns: 1 = file successful opened
     279!                   0 = error during open of existing file
     280!                  -1 = file does not exist
     281!
     282! CALLS: ibegst
     283! ........................................................
    284284
    285285      implicit integer*4 (i-n)
    … …  
    299299            if (j.gt.0.and.k.gt.0) then
    300300              open(lun,file=filnam(i:),status=stat(j:),
    301      #             form=format(k:),err=1)
     301     &             form=format(k:),err=1)
    302302              iopfil=1
    303303            endif
Note: See TracChangeset for help on using the changeset viewer.