rmcoment Subroutine

  1. korc_input.f90
  2. korc_input
  3. rmcoment

public subroutine rmcoment(fileold, filenew) 

 Strip comments.     Note: line lengths limited to 127 characters

-----------------------------------------------------------------------

 Close files and exit

Arguments

Type IntentOptional AttributesName
character(len=*), intent(in) :: fileold
character(len=*), intent(in) :: filenew

Called by

proc~~rmcoment~~CalledByGraph proc~rmcoment rmcoment proc~read_namelist read_namelist proc~read_namelist->proc~rmcoment proc~initialize_korc_parameters initialize_korc_parameters proc~initialize_korc_parameters->proc~read_namelist program~main main program~main->proc~initialize_korc_parameters

Contents

Source Code

rmcoment

Source Code

    SUBROUTINE rmcoment(fileold,filenew)

    CHARACTER(*), INTENT(IN) :: fileold,filenew
    CHARACTER(128) :: line
    INTEGER, PARAMETER :: nold=55,nnew=56
    INTEGER cmax, ios
    LOGICAL :: file_exist
!!-----------------------------------------------------------------------
!!     Open files, but make sure the old one exists first.
!!-----------------------------------------------------------------------
    INQUIRE(FILE=fileold,EXIST=file_exist)
    IF(.NOT. file_exist) THEN
       PRINT *,'The file "',fileold,'" could not be found.'
       STOP
    ENDIF

    OPEN(UNIT=default_unit_open,FILE=fileold,status="OLD",form='formatted')
    OPEN(UNIT=default_unit_write,FILE=filenew,status='REPLACE')

!!-----------------------------------------------------------------------
!!     Strip comments.     Note: line lengths limited to 127 characters
!!-----------------------------------------------------------------------
    DO
       READ(UNIT=default_unit_open,FMT='(a)',IOSTAT=ios) line
       IF (ios /= 0) EXIT
       cmax=1
       DO WHILE(line(cmax:cmax).NE.'!' .AND. cmax .LE. 127)
          cmax=cmax+1
       ENDDO
       IF(cmax .GT. 1) WRITE(default_unit_write,'(a)') line(1:cmax-1)
    ENDDO

!!-----------------------------------------------------------------------
!!     Close files and exit
!!-----------------------------------------------------------------------
    CLOSE(default_unit_open)
    CLOSE(default_unit_write)

  END SUBROUTINE rmcoment