PROGRAM load_nml CHARACTER(LEN=:) , ALLOCATABLE :: cdnambuff CHARACTER(LEN=20) :: cdnamfile='./nambdy' CHARACTER(LEN=256) :: chline CHARACTER(LEN=1) :: chsep INTEGER :: kout LOGICAL :: ldwp =.TRUE. !: .true. only for the root broadcaster INTEGER :: itot, iun, iltc, inl, ios, itotsav INTEGER :: nbdyind INTEGER :: nbdy_rdstart, nbdy_count, nbdy_loc NAMELIST /nambdy_index/nbdyind ! ! Check if the namelist buffer has already been allocated. Return if it has. ! !chsep = NEW_LINE('A') chsep = ' ' IF ( ALLOCATED( cdnambuff ) ) STOP IF( ldwp ) THEN ! ! Open namelist file ! iun=15 OPEN ( unit=iun, file=cdnamfile) ! ! First pass: count characters excluding comments and trimable white space ! itot=0 10 READ(iun,'(A256)',END=20,ERR=20) chline iltc = LEN_TRIM(chline) IF ( iltc.GT.0 ) THEN inl = INDEX(chline, '!') IF( inl.eq.0 ) THEN itot = itot + iltc + 1 ! +1 for the newline character ELSEIF( inl.GT.0 .AND. LEN_TRIM( chline(1:inl-1) ).GT.0 ) THEN itot = itot + inl ! includes +1 for the newline character ENDIF ENDIF GOTO 10 20 CONTINUE ! ! Allocate text cdnambuff for condensed namelist ! !$AGRIF_DO_NOT_TREAT ALLOCATE( CHARACTER(LEN=itot) :: cdnambuff ) !$AGRIF_END_DO_NOT_TREAT itotsav = itot ! ! Second pass: read and transfer pruned characters into cdnambuff ! REWIND(iun) itot=1 30 READ(iun,'(A256)',END=40,ERR=40) chline iltc = LEN_TRIM(chline) IF ( iltc.GT.0 ) THEN inl = INDEX(chline, '!') IF( inl.eq.0 ) THEN inl = iltc ELSE inl = inl - 1 ENDIF IF( inl.GT.0 .AND. LEN_TRIM( chline(1:inl) ).GT.0 ) THEN cdnambuff(itot:itot+inl-1) = chline(1:inl) WRITE( cdnambuff(itot+inl:itot+inl), '(a)' ) chsep itot = itot + inl + 1 ENDIF ENDIF GOTO 30 40 CONTINUE itot = itot - 1 IF( itotsav .NE. itot ) WRITE(*,*) 'WARNING in load_nml. Allocated ',itotsav,' for read buffer; but used ',itot ! ! Test the contents of the internal file ! ! Write it all out: write(6,'(a)') 'The whole internal file: ' write(6,'(32A)') cdnambuff write(6,'(a)')'----' ! Write out a sub-string of it write(6,'(a)') '25 characters from position 20: ' read(cdnambuff(20:),'(A25)') chline write(6,'(a)') TRIM(chline) write(6,'(a)')'----' write(6,'(a,i5)') 'Length of the compressed internal file: ',LEN_TRIM(cdnambuff) write(6,'(a)')'----' write(6,'(a)') 'nbdyind in the 1st occurrence of nambdy_index: ' read(cdnambuff(:), nambdy_index, end=99, err=99) write(6,'(a,i5)') 'nbdyind = ',nbdyind write(6,'(a)')'----' ! Now test reading the 4th occurrence of the namelist nbdy_rdstart = 1 DO nbdy_count = 1, 4 nbdy_loc = INDEX( cdnambuff( nbdy_rdstart: ), 'nambdy_index' ) IF( nbdy_loc .GT. 0 ) THEN nbdy_rdstart = nbdy_rdstart + nbdy_loc ELSE WRITE(*,'(A,I4,A)') 'Error: entry number ',nbdy_count,' of nambdy_index not found' ENDIF END DO nbdy_rdstart = MAX( 1, nbdy_rdstart - 2 ) read(cdnambuff(nbdy_rdstart:), nambdy_index, end=99, err=99) write(*,'(a,i5)') 'nbdyind in the 4th occurence of nbdyind = ',nbdyind goto 101 ! 99 write(6,'(a)') 'Not found' ! 101 REWIND(iun) write(6,'(a)')'----' write(6,'(a)')'Finally the first occurrence directly from the external namelist: ' read(iun,nambdy_index) write(*,'(a,i5)') 'nbdyind = ',nbdyind write(6,'(a)')'----' ! ! Close namelist file ! CLOSE(iun) ENDIF END PROGRAM load_nml