Gen_ANN_nh3_base/src/nnread.f

133 lines
3.7 KiB
Fortran

subroutine read_net_prim(fname,par,nlay,laystr,weistr,typop)
implicit none
! Subroutine reading ANN-parameters as generated by punch_net_prim
include 'nnparams.incl'
include 'nndbg.incl'
integer nlay
integer laystr(3,maxlay),typop(maxtypes,maxlay)
integer weistr(2,maxlay,2)
double precision par(*)
character*32 fname
character*2048 full_fname, net_id
integer neupop(maxlay)
integer par_end,len_out
integer file_maxtypes
integer j
full_fname = trim(fname) // '.par'
open(nnunit,file=trim(full_fname),status='old',action='read')
write(6,'(4096A)') '# READING ''' // trim(full_fname) // '''...'
! read structure parameters
read(nnunit,*,end=800) nlay
read(nnunit,*,end=801) file_maxtypes
! Nobody needs segfaults from corrupted input files.
if ((file_maxtypes.gt.maxtypes).or.(file_maxtypes.le.0)) then
write(6,'(A,I12)') 'ERROR: READ_NET_PRIM: '
> //'VARIABLE MAXTYPES OUT OF BOUNDS:',maxtypes
stop 1
else if ((nlay.gt.maxlay).or.(nlay.le.0)) then
write(6,'(A,I12)') 'ERROR: READ_NET_PRIM: '
> //'VARIABLE NLAY OUT OF BOUNDS:',nlay
stop 1
endif
read(nnunit,*,end=802) neupop(1:nlay)
read(nnunit,*,end=803) typop(1:file_maxtypes,1:nlay)
len_out=neupop(nlay)
net_id=' '
read(nnunit,'(2048A)',end=804) net_id
if (.not.(len_trim(net_id).eq.0)) then
write(6,'(4096A)') '# MODEL ID: ' // trim(net_id(4:))
endif
! initialize laystr
call mknet(laystr,weistr,neupop,nlay)
par_end=laystr(3,nlay)-1 !final W-position
! move to final bias
do j=2,nlay
par_end=par_end + neupop(j)
enddo
read(nnunit,*,end=805) par(1:par_end)
close(nnunit)
return
800 write(6,'(A)') 'ERROR: READ_NET_PRIM: BROKEN OR MISSING NLAY'
801 write(6,'(A)') 'ERROR: READ_NET_PRIM: BROKEN OR MISSING'
> // ' MAXTYPE'
802 write(6,'(A)') 'ERROR: READ_NET_PRIM: BROKEN OR MISSING NEUPOP'
803 write(6,'(A)') 'ERROR: READ_NET_PRIM: BROKEN OR MISSING TYPOP'
804 write(6,'(A)') 'ERROR: READ_NET_PRIM: BROKEN MODEL-ID'
805 write(6,'(A)') 'ERROR: READ_NET_PRIM: BROKEN OR MISSING PARAMS'
end
!--------------------------------------------------------------------------------
subroutine read_record(par,weistr,nlay,nset)
implicit none
include 'params.incl'
include 'common.incl'
include 'nnparams.incl'
include 'nncommon.incl'
include 'nndbg.incl'
double precision par(wbcap,maxset)
integer weistr(2,maxlay,2)
integer nlay,nset
integer wb_end, wb_end_rec
integer nset_rec
character*64 fname
integer k,k_rec
fname=trim(nnrecfile) // '.rec'
wb_end=weistr(2,nlay,2)
write(6,'(A)') 'RECORD: Reading record from file '''
> // trim(fname) // '''...'
open(nnunit,file=trim(fname),action='READ')
read(nnunit,*) nset_rec
if (nset_rec.ne.nset) then
write(6,'(A)') 'ERROR: INCONSISTENT NUMBER OF PARAMETER SETS.'
write(6,'("(",I4," vs.",I4,")")')
stop 1
endif
read(nnunit,*) wb_end_rec
if (wb_end_rec.ne.wb_end) then
write(6,'(A)') 'ERROR: INCONSISTENT NUMBER OF PARAMETER SETS.'
write(6,'("(",I4," vs.",I4,")")')
stop 1
endif
do k=1,nset
read(nnunit,*) k_rec, par(1:wb_end,k)
if (k.ne.k_rec) then
write(6,'(A,I05,A)') 'ERROR: MISSING PARAMETER SET: ', k
write(6,'(A,I05,A)') 'FOUND ', k_rec, ' INSTEAD'
stop 1
endif
enddo
close(nnunit)
write(6,'(A,I5)') 'Done. Read ',nset, ' parameter sets in total.'
end