44 public :: calcape, calcape2
49 public :: calrh_gfs, calrh_gsd, calrh_nam
51 public :: calslr_roebber, calslr_uutah
70 SUBROUTINE calrh(P1,T1,Q1,RH)
72 use ctlblk_mod,
only: ista, iend, jsta, jend, modelname
75 REAL,
dimension(ista:iend,jsta:jend),
intent(in) :: p1,t1
76 REAL,
dimension(ista:iend,jsta:jend),
intent(inout) :: q1
77 REAL,
dimension(ista:iend,jsta:jend),
intent(out) :: rh
79 IF(modelname ==
'RAPR')
THEN
80 CALL calrh_gsd(p1,t1,q1,rh)
82 CALL calrh_nam(p1,t1,q1,rh)
116 SUBROUTINE calrh_nam(P1,T1,Q1,RH)
117 use params_mod,
only: pq0, a2, a3, a4, rhmin
118 use ctlblk_mod,
only: ista, iend, jsta, jend, spval
126 REAL,
dimension(ista:iend,jsta:jend),
intent(in) :: p1,t1
127 REAL,
dimension(ista:iend,jsta:jend),
intent(inout) :: q1
128 REAL,
dimension(ista:iend,jsta:jend),
intent(out) :: rh
137 IF (t1(i,j) < spval)
THEN
138 IF (abs(p1(i,j)) >= 1)
THEN
139 qc = pq0/p1(i,j)*exp(a2*(t1(i,j)-a3)/(t1(i,j)-a4))
145 IF (rh(i,j) > 1.0)
THEN
149 IF (rh(i,j) < rhmin)
THEN
163 END SUBROUTINE calrh_nam
195 SUBROUTINE calrh_gfs(P1,T1,Q1,RH)
196 use params_mod,
only: rhmin
197 use ctlblk_mod,
only: ista, iend, jsta, jend, spval
201 real,
parameter:: con_rd =2.8705e+2
202 real,
parameter:: con_rv =4.6150e+2
203 real,
parameter:: con_eps =con_rd/con_rv
204 real,
parameter:: con_epsm1 =con_rd/con_rv-1
214 REAL,
dimension(ista:iend,jsta:jend),
intent(in) :: p1,t1
215 REAL,
dimension(ista:iend,jsta:jend),
intent(inout):: q1,rh
225 IF (t1(i,j) < spval .AND. p1(i,j) < spval.AND.q1(i,j)/=spval)
THEN
228 IF (p1(i,j) >= 1.0)
THEN
229 es = min(fpvsnew(t1(i,j)),p1(i,j))
230 qc = con_eps*es/(p1(i,j)+con_epsm1*es)
234 rh(i,j) = min(1.0,max(q1(i,j)/qc,rhmin))
254 END SUBROUTINE calrh_gfs
268 SUBROUTINE calrh_gsd(P1,T1,Q1,RHB)
271 use ctlblk_mod,
only: ista, iend, jsta, jend, spval
276 real :: tx, pol, esx, es, e
277 real,
dimension(ista:iend,jsta:jend) :: p1, t1, q1, rhb
282 IF (t1(i,j) < spval .AND. p1(i,j) < spval .AND. q1(i,j) < spval)
THEN
285 pol = 0.99999683 + tx*(-0.90826951e-02 + &
286 tx*(0.78736169e-04 + tx*(-0.61117958e-06 + &
287 tx*(0.43884187e-08 + tx*(-0.29883885e-10 + &
288 tx*(0.21874425e-12 + tx*(-0.17892321e-14 + &
289 tx*(0.11112018e-16 + tx*(-0.30994571e-19)))))))))
293 e = p1(i,j)/100.*q1(i,j)/(0.62197+q1(i,j)*0.37803)
294 rhb(i,j) = min(1.,e/es)
301 END SUBROUTINE calrh_gsd
310 SUBROUTINE calrh_pw(RHPW)
315 use vrbls3d,
only: q, pmid, t
316 use params_mod,
only: g
317 use ctlblk_mod,
only: lm, ista, iend, jsta, jend, spval
321 real,
PARAMETER :: svp1=6.1153,svp2=17.67,svp3=29.65
323 REAL,
dimension(ista:iend,jsta:jend):: pw, pw_sat, rhpw
324 REAL deltp,sh,qv,temp,es,qs,qv_sat
325 integer i,j,l,k,ka,kb
336 if(t(i,j,k)<spval.and.q(i,j,k)<spval)
then
343 deltp = 0.5*(pmid(i,j,kb)-pmid(i,j,ka))
344 pw(i,j) = pw(i,j) + sh *deltp/g
351 es = svp1*exp(svp2*(temp-273.15)/(temp-svp3))
353 qs = 0.62198*es/(pmid(i,j,k)*1.e-2-0.37802*es)
357 pw_sat(i,j) = pw_sat(i,j) + max(sh,qs)*deltp/g
364 rhpw(i,j) = min(1.,pw(i,j) / pw_sat(i,j)) * 100.
372 END SUBROUTINE calrh_pw
398 elemental function fpvsnew(t)
401 integer,
parameter:: nxpvs=7501
402 real,
parameter:: con_ttp =2.7316e+2
403 real,
parameter:: con_psat =6.1078e+2
404 real,
parameter:: con_cvap =1.8460e+3
405 real,
parameter:: con_cliq =4.1855e+3
406 real,
parameter:: con_hvap =2.5000e+6
407 real,
parameter:: con_rv =4.6150e+2
408 real,
parameter:: con_csol =2.1060e+3
409 real,
parameter:: con_hfus =3.3358e+5
410 real,
parameter:: tliq=con_ttp
411 real,
parameter:: tice=con_ttp-20.0
412 real,
parameter:: dldtl=con_cvap-con_cliq
413 real,
parameter:: heatl=con_hvap
414 real,
parameter:: xponal=-dldtl/con_rv
415 real,
parameter:: xponbl=-dldtl/con_rv+heatl/(con_rv*con_ttp)
416 real,
parameter:: dldti=con_cvap-con_csol
417 real,
parameter:: heati=con_hvap+con_hfus
418 real,
parameter:: xponai=-dldti/con_rv
419 real,
parameter:: xponbi=-dldti/con_rv+heati/(con_rv*con_ttp)
424 real xj,x,tbpvs(nxpvs),xp1
425 real xmin,xmax,xinc,c2xpvs,c1xpvs
429 xinc=(xmax-xmin)/(nxpvs-1)
432 c1xpvs=1.-xmin*c2xpvs
434 xj=min(max(c1xpvs+c2xpvs*t,1.0),float(nxpvs))
435 jx=min(xj,float(nxpvs)-1.0)
440 tbpvs(jx)=con_psat*(tr**xponal)*exp(xponbl*(1.-tr))
442 tbpvs(jx)=con_psat*(tr**xponai)*exp(xponbi*(1.-tr))
444 w=(t-tice)/(tliq-tice)
445 pvl=con_psat*(tr**xponal)*exp(xponbl*(1.-tr))
446 pvi=con_psat*(tr**xponai)*exp(xponbi*(1.-tr))
447 tbpvs(jx)=w*pvl+(1.-w)*pvi
450 xp1=xmin+(jx-1+1)*xinc
454 tbpvs(jx+1)=con_psat*(tr**xponal)*exp(xponbl*(1.-tr))
455 elseif(xp1<tice)
then
456 tbpvs(jx+1)=con_psat*(tr**xponai)*exp(xponbi*(1.-tr))
458 w=(t-tice)/(tliq-tice)
459 pvl=con_psat*(tr**xponal)*exp(xponbl*(1.-tr))
460 pvi=con_psat*(tr**xponai)*exp(xponbi*(1.-tr))
461 tbpvs(jx+1)=w*pvl+(1.-w)*pvi
464 fpvsnew=tbpvs(jx)+(xj-jx)*(tbpvs(jx+1)-tbpvs(jx))
561 SUBROUTINE calcape(ITYPE,DPBND,P1D,T1D,Q1D,L1D,CAPE, &
562 CINS,PPARC,ZEQL,THUND)
563 use vrbls3d,
only: pmid, t, q, zint
564 use vrbls2d,
only: teql,ieql
566 use params_mod,
only: d00, h1m12, h99999, h10e5, capa, elocp, eps, &
568 use lookup_mod,
only: thl, rdth, jtb, qs0, sqs, rdq, itb, ptbl, &
569 plq, ttbl, pl, rdp, the0, sthe, rdthe, ttblq, &
570 itbq, jtbq, rdpq, the0q, stheq, rdtheq
571 use ctlblk_mod,
only: jsta_2l, jend_2u, lm, jsta, jend, im, me, spval, &
572 ista_2l, iend_2u, ista, iend
578 real,
PARAMETER :: ismthp=2,ismtht=2,ismthq=2
582 integer,
intent(in) :: itype
583 real,
intent(in) :: dpbnd
584 integer,
dimension(ista:iend,Jsta:jend),
intent(in) :: l1d
585 real,
dimension(ista:iend,Jsta:jend),
intent(in) :: p1d,t1d
586 real,
dimension(ista:iend,jsta:jend),
intent(inout) :: q1d,cape,cins,pparc,zeql
588 integer,
dimension(ista:iend,jsta:jend) :: iptb, ithtb, parcel, klres, khres, lcl, idx
590 real,
dimension(ista:iend,jsta:jend) :: thesp, psp, cape20, qq, pp, thund
591 REAL,
ALLOCATABLE :: tpar(:,:,:)
593 LOGICAL thunder(ista:iend,jsta:jend), needthun
594 real psfck,pkl,tbtk,qbtk,apebtk,tthbtk,tthk,apespk,tpspk, &
595 bqs00k,sqs00k,bqs10k,sqs10k,bqk,sqk,tqk,presk,gdzkl,thetap, &
596 thetaa,p00k,p10k,p01k,p11k,tthesk,esatp,qsatp,tvp,tv
598 integer i,j,l,knuml,knumh,lbeg,lend,iq, kb,ittbk
605 ALLOCATE(tpar(ista_2l:iend_2u,jsta_2l:jend_2u,lm))
639 thunder(i,j) = .true.
660 q1d(i,j) = min(max(h1m12,q1d(i,j)),h99999)
670 IF (itype == 1 .OR. (itype == 2 .AND. kb == 1))
THEN
677 psfck = pmid(i,j,nint(lmh(i,j)))
679 IF(psfck<spval.and.pkl<spval)
THEN
683 (itype == 1 .AND. (pkl >= psfck-dpbnd .AND. pkl <= psfck)))
THEN
686 qbtk = max(0.0, q(i,j,kb))
687 apebtk = (h10e5/pkl)**capa
691 qbtk = max(0.0, q1d(i,j))
692 apebtk = (h10e5/pkl)**capa
703 tthk = (tthbtk-thl)*rdth
704 qq(i,j) = tthk - aint(tthk)
705 ittbk = int(tthk) + 1
711 IF(ittbk >= jtb)
THEN
718 bqs10k = qs0(ittbk+1)
719 sqs10k = sqs(ittbk+1)
721 bqk = (bqs10k-bqs00k)*qq(i,j) + bqs00k
722 sqk = (sqs10k-sqs00k)*qq(i,j) + sqs00k
723 tqk = (qbtk-bqk)/sqk*rdq
724 pp(i,j) = tqk-aint(tqk)
736 p00k = ptbl(iq ,ittbk )
737 p10k = ptbl(iq+1,ittbk )
738 p01k = ptbl(iq ,ittbk+1)
739 p11k = ptbl(iq+1,ittbk+1)
741 tpspk = p00k + (p10k-p00k)*pp(i,j) + (p01k-p00k)*qq(i,j) &
742 + (p00k-p10k-p01k+p11k)*pp(i,j)*qq(i,j)
745 if (tpspk > 1.0e-3)
then
746 apespk = (max(0.,h10e5/ tpspk))**capa
751 tthesk = tthbtk * exp(elocp*qbtk*apespk/tthbtk)
753 IF(tthesk > thesp(i,j))
THEN
769 pparc(i,j) = pmid(i,j,parcel(i,j))
780 IF (pmid(i,j,l) < psp(i,j)) lcl(i,j) = l+1
787 IF (lcl(i,j) > nint(lmh(i,j))) lcl(i,j) = nint(lmh(i,j))
789 IF (t(i,j,lcl(i,j)) < 263.15)
THEN
790 thunder(i,j) = .false.
807 IF(l <= lcl(i,j))
THEN
808 IF(pmid(i,j,l) < plq)
THEN
822 CALL ttblex(tpar(ista_2l,jsta_2l,l),ttbl,itb,jtb,klres &
823 , pmid(ista_2l,jsta_2l,l),pl,qq,pp,rdp,the0,sthe &
824 , rdthe,thesp,iptb,ithtb)
830 CALL ttblex(tpar(ista_2l,jsta_2l,l),ttblq,itbq,jtbq,khres &
831 , pmid(ista_2l,jsta_2l,l),plq,qq,pp,rdpq &
832 ,the0q,stheq,rdtheq,thesp,iptb,ithtb)
839 IF(khres(i,j) > 0)
THEN
840 IF(tpar(i,j,l) > t(i,j,l)) ieql(i,j) = l
848 IF(klres(i,j) > 0)
THEN
849 IF(tpar(i,j,l) > t(i,j,l) .AND. &
850 pmid(i,j,l)>100.) ieql(i,j) = l
861 lbeg = min(ieql(i,j),lbeg)
862 lend = max(lcl(i,j),lend)
869 IF(t(i,j,ieql(i,j)) > 255.65)
THEN
870 thunder(i,j) = .false.
881 IF(l >= ieql(i,j).AND.l <= lcl(i,j))
THEN
890 IF(idx(i,j) > 0)
THEN
892 gdzkl = (zint(i,j,l)-zint(i,j,l+1)) * g
893 esatp = min(fpvsnew(tpar(i,j,l)),presk)
894 qsatp = eps*esatp/(presk-esatp*oneps)
896 tvp = tvirtual(tpar(i,j,l),qsatp)
897 thetap = tvp*(h10e5/presk)**capa
899 tv = tvirtual(t(i,j,l),q(i,j,l))
900 thetaa = tv*(h10e5/presk)**capa
901 IF(thetap < thetaa)
THEN
902 cins(i,j) = cins(i,j) + (log(thetap)-log(thetaa))*gdzkl
903 ELSEIF(thetap > thetaa)
THEN
904 cape(i,j) = cape(i,j) + (log(thetap)-log(thetaa))*gdzkl
905 IF (thunder(i,j) .AND. t(i,j,l) < 273.15 &
906 .AND. t(i,j,l) > 253.15)
THEN
907 cape20(i,j) = cape20(i,j) + (log(thetap)-log(thetaa))*gdzkl
921 cape(i,j) = max(d00,cape(i,j))
922 cins(i,j) = min(cins(i,j),d00)
924 zeql(i,j) = zint(i,j,ieql(i,j))
925 teql(i,j) = t(i,j,ieql(i,j))
926 IF (cape20(i,j) < 75.)
THEN
927 thunder(i,j) = .false.
929 IF (thunder(i,j))
THEN
939 END SUBROUTINE calcape
1039 SUBROUTINE calcape2(ITYPE,DPBND,P1D,T1D,Q1D,L1D, &
1040 CAPE,CINS,LFC,ESRHL,ESRHH, &
1042 use vrbls3d,
only: pmid, t, q, zint
1043 use vrbls2d,
only: fis,ieql
1044 use gridspec_mod,
only: gridtype
1045 use masks,
only: lmh
1046 use params_mod,
only: d00, h1m12, h99999, h10e5, capa, elocp, eps, &
1048 use lookup_mod,
only: thl, rdth, jtb, qs0, sqs, rdq, itb, ptbl, &
1049 plq, ttbl, pl, rdp, the0, sthe, rdthe, ttblq, &
1050 itbq, jtbq, rdpq, the0q, stheq, rdtheq
1051 use ctlblk_mod,
only: jsta_2l, jend_2u, lm, jsta, jend, im, jm, me, jsta_m, jend_m, spval,&
1052 ista_2l, iend_2u, ista, iend, ista_m, iend_m
1058 real,
PARAMETER :: ismthp=2,ismtht=2,ismthq=2
1062 integer,
intent(in) :: itype
1063 real,
intent(in) :: dpbnd
1064 integer,
dimension(ista:iend,Jsta:jend),
intent(in) :: l1d
1065 real,
dimension(ista:iend,Jsta:jend),
intent(in) :: p1d,t1d
1067 real,
dimension(ista:iend,jsta:jend),
intent(inout) :: q1d,cape,cins
1068 real,
dimension(ista:iend,jsta:jend) :: pparc,zeql
1069 real,
dimension(ista:iend,jsta:jend),
intent(inout) :: lfc,esrhl,esrhh
1070 real,
dimension(ista:iend,jsta:jend),
intent(inout) :: dcape,dgld,esp
1071 integer,
dimension(ista:iend,jsta:jend) ::l12,l17,l3km
1073 integer,
dimension(ista:iend,jsta:jend) :: iptb, ithtb, parcel, klres, khres, lcl, idx
1075 real,
dimension(ista:iend,jsta:jend) :: thesp, psp, cape20, qq, pp, thund
1076 integer,
dimension(ista:iend,jsta:jend) :: parcel2
1077 real,
dimension(ista:iend,jsta:jend) :: thesp2,psp2
1078 real,
dimension(ista:iend,jsta:jend) :: cape4,cins4
1079 REAL,
ALLOCATABLE :: tpar(:,:,:)
1080 REAL,
ALLOCATABLE :: tpar2(:,:,:)
1082 LOGICAL thunder(ista:iend,jsta:jend), needthun
1083 real psfck,pkl,tbtk,qbtk,apebtk,tthbtk,tthk,apespk,tpspk, &
1084 bqs00k,sqs00k,bqs10k,sqs10k,bqk,sqk,tqk,presk,gdzkl,thetap, &
1085 thetaa,p00k,p10k,p01k,p11k,tthesk,esatp,qsatp,tvp,tv
1086 real presk2, esatp2, qsatp2, tvp2, thetap2, tv2, thetaa2
1088 integer i,j,l,knuml,knumh,lbeg,lend,iq, kb,ittbk
1089 integer ie,iw,jn,js,ive(jm),ivw(jm),jvn,jvs
1090 integer istart,istop,jstart,jstop
1091 real,
dimension(ista:iend,jsta:jend) :: htsfc
1098 ALLOCATE(tpar(ista_2l:iend_2u,jsta_2l:jend_2u,lm))
1099 ALLOCATE(tpar2(ista_2l:iend_2u,jsta_2l:jend_2u,lm))
1135 thunder(i,j) = .true.
1160 IF(gridtype ==
'E')
THEN
1171 ELSE IF(gridtype ==
'B')
THEN
1195 IF(gridtype /=
'A')
CALL exch(fis(ista:iend,jsta:jend))
1205 IF (gridtype==
'B')
THEN
1206 htsfc(i,j) = (0.25/g)*(fis(iw,j)+fis(ie,j)+fis(i,jn)+fis(ie,jn))
1208 htsfc(i,j) = (0.25/g)*(fis(iw,j)+fis(ie,j)+fis(i,jn)+fis(i,js))
1217 IF (itype == 2)
THEN
1221 q1d(i,j) = min(max(h1m12,q1d(i,j)),h99999)
1231 IF (itype == 1 .OR. (itype == 2 .AND. kb == 1))
THEN
1238 psfck = pmid(i,j,nint(lmh(i,j)))
1242 IF (itype ==2 .OR. &
1243 (itype == 1 .AND. (pkl >= psfck-dpbnd .AND. pkl <= psfck)))
THEN
1244 IF (itype == 1)
THEN
1246 qbtk = max(0.0, q(i,j,kb))
1247 apebtk = (h10e5/pkl)**capa
1251 qbtk = max(0.0, q1d(i,j))
1252 apebtk = (h10e5/pkl)**capa
1262 tthbtk = tbtk*apebtk
1263 tthk = (tthbtk-thl)*rdth
1264 qq(i,j) = tthk - aint(tthk)
1265 ittbk = int(tthk) + 1
1271 IF(ittbk >= jtb)
THEN
1278 bqs10k = qs0(ittbk+1)
1279 sqs10k = sqs(ittbk+1)
1281 bqk = (bqs10k-bqs00k)*qq(i,j) + bqs00k
1282 sqk = (sqs10k-sqs00k)*qq(i,j) + sqs00k
1283 tqk = (qbtk-bqk)/sqk*rdq
1284 pp(i,j) = tqk-aint(tqk)
1296 p00k = ptbl(iq ,ittbk )
1297 p10k = ptbl(iq+1,ittbk )
1298 p01k = ptbl(iq ,ittbk+1)
1299 p11k = ptbl(iq+1,ittbk+1)
1301 tpspk = p00k + (p10k-p00k)*pp(i,j) + (p01k-p00k)*qq(i,j) &
1302 + (p00k-p10k-p01k+p11k)*pp(i,j)*qq(i,j)
1305 if (tpspk > 1.0e-3)
then
1306 apespk = (max(0.,h10e5/ tpspk))**capa
1311 tthesk = tthbtk * exp(elocp*qbtk*apespk/tthbtk)
1313 IF(tthesk > thesp(i,j))
THEN
1319 IF(tthesk < thesp2(i,j))
THEN
1321 thesp2(i,j) = tthesk
1334 pparc(i,j) = pmid(i,j,parcel(i,j))
1345 IF (pmid(i,j,l) < psp(i,j)) lcl(i,j) = l+1
1352 IF (lcl(i,j) > nint(lmh(i,j))) lcl(i,j) = nint(lmh(i,j))
1354 IF (t(i,j,lcl(i,j)) < 263.15)
THEN
1355 thunder(i,j) = .false.
1360 lcl(i,j) = max(min(lcl(i,j),lm-1),1)
1374 IF(l <= lcl(i,j))
THEN
1375 IF(pmid(i,j,l) < plq)
THEN
1389 CALL ttblex(tpar(ista_2l,jsta_2l,l),ttbl,itb,jtb,klres &
1390 , pmid(ista_2l,jsta_2l,l),pl,qq,pp,rdp,the0,sthe &
1391 , rdthe,thesp,iptb,ithtb)
1397 CALL ttblex(tpar(ista_2l,jsta_2l,l),ttblq,itbq,jtbq,khres &
1398 , pmid(ista_2l,jsta_2l,l),plq,qq,pp,rdpq &
1399 ,the0q,stheq,rdtheq,thesp,iptb,ithtb)
1406 IF(khres(i,j) > 0)
THEN
1407 IF(tpar(i,j,l) > t(i,j,l)) ieql(i,j) = l
1415 IF(klres(i,j) > 0)
THEN
1416 IF(tpar(i,j,l) > t(i,j,l)) ieql(i,j) = l
1427 lbeg = min(ieql(i,j),lbeg)
1428 lend = max(lcl(i,j),lend)
1435 IF(t(i,j,ieql(i,j)) > 255.65)
THEN
1436 thunder(i,j) = .false.
1456 IF(l >= ieql(i,j).AND.l <= lcl(i,j))
THEN
1466 IF(idx(i,j) > 0)
THEN
1468 gdzkl = (zint(i,j,l)-zint(i,j,l+1)) * g
1469 esatp = min(fpvsnew(tpar(i,j,l)),presk)
1470 qsatp = eps*esatp/(presk-esatp*oneps)
1472 tvp = tvirtual(tpar(i,j,l),qsatp)
1473 thetap = tvp*(h10e5/presk)**capa
1475 tv = tvirtual(t(i,j,l),q(i,j,l))
1476 thetaa = tv*(h10e5/presk)**capa
1477 IF(thetap < thetaa)
THEN
1478 cins4(i,j) = cins4(i,j) + (log(thetap)-log(thetaa))*gdzkl
1479 IF(zint(i,j,l)-htsfc(i,j) <= 3000.)
THEN
1480 cins(i,j) = cins(i,j) + (log(thetap)-log(thetaa))*gdzkl
1482 ELSEIF(thetap > thetaa)
THEN
1483 cape4(i,j) = cape4(i,j) + (log(thetap)-log(thetaa))*gdzkl
1484 IF(zint(i,j,l)-htsfc(i,j) <= 3000.)
THEN
1485 cape(i,j) = cape(i,j) + (log(thetap)-log(thetaa))*gdzkl
1487 IF (thunder(i,j) .AND. t(i,j,l) < 273.15 &
1488 .AND. t(i,j,l) > 253.15)
THEN
1489 cape20(i,j) = cape20(i,j) + (log(thetap)-log(thetaa))*gdzkl
1494 IF (itype /= 1)
THEN
1495 presk2 = pmid(i,j,l+1)
1496 esatp2 = min(fpvsnew(tpar(i,j,l+1)),presk2)
1497 qsatp2 = eps*esatp2/(presk2-esatp2*oneps)
1499 tvp2 = tvirtual(tpar(i,j,l+1),qsatp2)
1500 thetap2 = tvp2*(h10e5/presk2)**capa
1502 tv2 = tvirtual(t(i,j,l+1),q(i,j,l+1))
1503 thetaa2 = tv2*(h10e5/presk2)**capa
1504 IF(thetap >= thetaa .AND. thetap2 <= thetaa2)
THEN
1505 IF(lfc(i,j) == d00)
THEN
1506 lfc(i,j) = zint(i,j,l)
1512 IF(zint(i,j,l)-htsfc(i,j) <= 3000.)
THEN
1513 IF(cape4(i,j) >= 100. .AND. cins4(i,j) >= -250.)
THEN
1514 IF(esrhl(i,j) == lcl(i,j)) esrhl(i,j)=l
1527 IF(esrhh(i,j) > esrhl(i,j)) esrhh(i,j)=ieql(i,j)
1538 cape(i,j) = max(d00,cape(i,j))
1539 cins(i,j) = min(cins(i,j),d00)
1541 zeql(i,j) = zint(i,j,ieql(i,j))
1542 lfc(i,j) = min(lfc(i,j),zint(i,j,ieql(i,j)))
1543 lfc(i,j) = max(zint(i,j, lcl(i,j)),lfc(i,j))
1544 IF (cape20(i,j) < 75.)
THEN
1545 thunder(i,j) = .false.
1547 IF (thunder(i,j))
THEN
1558 IF (itype == 1)
THEN
1568 psfck = pmid(i,j,nint(lmh(i,j)))
1570 IF(pkl >= psfck-dpbnd)
THEN
1571 IF(pmid(i,j,l) < plq)
THEN
1585 CALL ttblex(tpar2(ista_2l,jsta_2l,l),ttbl,itb,jtb,klres &
1586 , pmid(ista_2l,jsta_2l,l),pl,qq,pp,rdp,the0,sthe &
1587 , rdthe,thesp2,iptb,ithtb)
1593 CALL ttblex(tpar2(ista_2l,jsta_2l,l),ttblq,itbq,jtbq,khres &
1594 , pmid(ista_2l,jsta_2l,l),plq,qq,pp,rdpq &
1595 , the0q,stheq,rdtheq,thesp2,iptb,ithtb)
1607 IF(l >= parcel2(i,j).AND.l < nint(lmh(i,j)))
THEN
1616 IF(idx(i,j) > 0)
THEN
1618 gdzkl = (zint(i,j,l)-zint(i,j,l+1)) * g
1619 esatp = min(fpvsnew(tpar2(i,j,l)),presk)
1620 qsatp = eps*esatp/(presk-esatp*oneps)
1622 tvp = tvirtual(tpar2(i,j,l),qsatp)
1623 thetap = tvp*(h10e5/presk)**capa
1625 tv = tvirtual(t(i,j,l),q(i,j,l))
1626 thetaa = tv*(h10e5/presk)**capa
1628 dcape(i,j) = dcape(i,j) + (log(thetap)-log(thetaa))*gdzkl
1638 dcape(i,j) = min(d00,dcape(i,j))
1654 IF(t(i,j,l) <= tfrz-12. .AND. l12(i,j)==lm) l12(i,j)=l
1655 IF(t(i,j,l) <= tfrz-17. .AND. l17(i,j)==lm) l17(i,j)=l
1662 IF(l12(i,j)/=lm .AND. l17(i,j)/=lm)
THEN
1663 dgld(i,j)=zint(i,j,l17(i,j))-zint(i,j,l12(i,j))
1664 dgld(i,j)=max(dgld(i,j),0.)
1678 IF(zint(i,j,l)-htsfc(i,j) <= 3000.) l3km(i,j)=l
1685 esp(i,j) = (cape(i,j) / 50.) * (t(i,j,lm) - t(i,j,l3km(i,j)) - 7.0)
1686 IF((t(i,j,lm) - t(i,j,l3km(i,j))) < 7.0) esp(i,j) = 0.
1694 END SUBROUTINE calcape2
1701 elemental function tvirtual(T,Q)
1711 REAL,
INTENT(IN) :: t, q
1713 tvirtual = t*(1+0.608*q)
1715 end function tvirtual
1743 SUBROUTINE calvor(UWND,VWND,ABSV)
1746 use vrbls2d,
only: f
1747 use masks,
only: gdlat, gdlon, dx, dy
1748 use params_mod,
only: d00, dtr, small, erad
1749 use ctlblk_mod,
only: jsta_2l, jend_2u, spval, modelname, global, &
1750 jsta, jend, im, jm, jsta_m, jend_m, gdsdegr,&
1751 ista, iend, ista_m, iend_m, ista_2l, iend_2u, me, num_procs
1752 use gridspec_mod,
only: gridtype, dyval
1753 use upp_math,
only: dvdxdudy, ddvdx, ddudy, uuavg
1759 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(in) :: uwnd, vwnd
1760 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(inout) :: absv
1761 REAL,
dimension(IM,2) :: glatpoles, coslpoles, upoles, avpoles
1762 REAL,
dimension(IM,JSTA:JEND) :: cosltemp, avtemp
1764 real,
allocatable :: wrk1(:,:), wrk2(:,:), wrk3(:,:), cosl(:,:)
1765 INTEGER,
allocatable :: ihe(:),ihw(:), ie(:),iw(:)
1767 integer,
parameter :: npass2=2, npass3=3
1768 integer i,j,ip1,im1,ii,iir,iil,jj,jmt2,imb2, npass, nn, jtem
1769 real r2dx,r2dy,dvdx,dudy,uavg,tph1,tphi, tx1(im+2), tx2(im+2)
1776 IF(modelname ==
'RAPR')
then
1778 DO j=jsta_2l,jend_2u
1779 DO i=ista_2l,iend_2u
1785 DO j=jsta_2l,jend_2u
1786 DO i=ista_2l,iend_2u
1795 IF (modelname ==
'GFS' .or. global)
THEN
1796 CALL exch(gdlat(ista_2l,jsta_2l))
1797 CALL exch(gdlon(ista_2l,jsta_2l))
1799 allocate (wrk1(ista:iend,jsta:jend), wrk2(ista:iend,jsta:jend), &
1800 & wrk3(ista:iend,jsta:jend), cosl(ista_2l:iend_2u,jsta_2l:jend_2u))
1801 allocate(iw(im),ie(im))
1822 cosl(i,j) = cos(gdlat(i,j)*dtr)
1823 IF(cosl(i,j) >= small)
then
1824 wrk1(i,j) = 1.0 / (erad*cosl(i,j))
1828 if(i == im .or. i == 1)
then
1829 wrk2(i,j) = 1.0 / ((360.+gdlon(ip1,j)-gdlon(im1,j))*dtr)
1831 wrk2(i,j) = 1.0 / ((gdlon(ip1,j)-gdlon(im1,j))*dtr)
1838 call fullpole( cosl(ista_2l:iend_2u,jsta_2l:jend_2u),coslpoles)
1839 call fullpole(gdlat(ista_2l:iend_2u,jsta_2l:jend_2u),glatpoles)
1844 if(gdlat(ista,j) > 0.)
then
1847 if (ii > im) ii = ii - im
1849 wrk3(i,j) = 1.0 / ((180.-gdlat(i,j+1)-glatpoles(ii,1))*dtr)
1854 if (ii > im) ii = ii - im
1856 wrk3(i,j) = 1.0 / ((180.+gdlat(i,j+1)+glatpoles(ii,1))*dtr)
1860 elseif (j == jm)
then
1861 if(gdlat(ista,j) < 0.)
then
1864 if (ii > im) ii = ii - im
1866 wrk3(i,j) = 1.0 / ((180.+gdlat(i,j-1)+glatpoles(ii,2))*dtr)
1871 if (ii > im) ii = ii - im
1873 wrk3(i,j) = 1.0 / ((180.-gdlat(i,j-1)-glatpoles(ii,2))*dtr)
1878 wrk3(i,j) = 1.0 / ((gdlat(i,j-1)-gdlat(i,j+1))*dtr)
1887 call fullpole(uwnd(ista_2l:iend_2u,jsta_2l:jend_2u),upoles)
1894 if(gdlat(ista,j) > 0.)
then
1895 IF(cosl(ista,j) >= small)
THEN
1900 if (ii > im) ii = ii - im
1901 if(vwnd(ip1,j)==spval .or. vwnd(im1,j)==spval .or. &
1903 upoles(ii,1)==spval .or. uwnd(i,j+1)==spval) cycle
1904 absv(i,j) = ((vwnd(ip1,j)-vwnd(im1,j))*wrk2(i,j) &
1906 & + (upoles(ii,1)*coslpoles(ii,1) &
1907 & + uwnd(i,j+1)*cosl(i,j+1))*wrk3(i,j)) * wrk1(i,j) &
1915 if(vwnd(ip1,jj)==spval .or. vwnd(im1,jj)==spval .or. &
1916 uwnd(i,j)==spval .or. uwnd(i,jj+1)==spval) cycle
1917 absv(i,j) = ((vwnd(ip1,jj)-vwnd(im1,jj))*wrk2(i,jj) &
1918 & - (uwnd(i,j)*cosl(i,j) &
1919 - uwnd(i,jj+1)*cosl(i,jj+1))*wrk3(i,jj)) * wrk1(i,jj) &
1924 IF(cosl(ista,j) >= small)
THEN
1929 if (ii > im) ii = ii - im
1930 if(vwnd(ip1,j)==spval .or. vwnd(im1,j)==spval .or. &
1932 upoles(ii,1)==spval .or. uwnd(i,j+1)==spval) cycle
1933 absv(i,j) = ((vwnd(ip1,j)-vwnd(im1,j))*wrk2(i,j) &
1935 & - (upoles(ii,1)*coslpoles(ii,1) &
1936 & + uwnd(i,j+1)*cosl(i,j+1))*wrk3(i,j)) * wrk1(i,j) &
1944 if(vwnd(ip1,jj)==spval .or. vwnd(im1,jj)==spval .or. &
1945 uwnd(i,j)==spval .or. uwnd(i,jj+1)==spval) cycle
1946 absv(i,j) = ((vwnd(ip1,jj)-vwnd(im1,jj))*wrk2(i,jj) &
1947 & + (uwnd(i,j)*cosl(i,j) &
1948 - uwnd(i,jj+1)*cosl(i,jj+1))*wrk3(i,jj)) * wrk1(i,jj) &
1953 ELSE IF(j == jm)
THEN
1954 if(gdlat(ista,j) < 0.)
then
1955 IF(cosl(ista,j) >= small)
THEN
1960 if (ii > im) ii = ii - im
1961 if(vwnd(ip1,j)==spval .or. vwnd(im1,j)==spval .or. &
1963 uwnd(i,j-1)==spval .or. upoles(ii,2)==spval) cycle
1964 absv(i,j) = ((vwnd(ip1,j)-vwnd(im1,j))*wrk2(i,j) &
1965 & - (uwnd(i,j-1)*cosl(i,j-1) &
1967 & + upoles(ii,2)*coslpoles(ii,2))*wrk3(i,j)) * wrk1(i,j) &
1975 if(vwnd(ip1,jj)==spval .or. vwnd(im1,jj)==spval .or. &
1976 uwnd(i,jj-1)==spval .or. uwnd(i,j)==spval) cycle
1977 absv(i,j) = ((vwnd(ip1,jj)-vwnd(im1,jj))*wrk2(i,jj) &
1978 & - (uwnd(i,jj-1)*cosl(i,jj-1) &
1979 & - uwnd(i,j)*cosl(i,j))*wrk3(i,jj)) * wrk1(i,jj) &
1984 IF(cosl(ista,j) >= small)
THEN
1989 if (ii > im) ii = ii - im
1990 if(vwnd(ip1,j)==spval .or. vwnd(im1,j)==spval .or. &
1992 uwnd(i,j-1)==spval .or. upoles(ii,2)==spval) cycle
1993 absv(i,j) = ((vwnd(ip1,j)-vwnd(im1,j))*wrk2(i,j) &
1994 & + (uwnd(i,j-1)*cosl(i,j-1) &
1996 & + upoles(ii,2)*coslpoles(ii,2))*wrk3(i,j)) * wrk1(i,j) &
2004 if(vwnd(ip1,jj)==spval .or. vwnd(im1,jj)==spval .or. &
2005 uwnd(i,jj-1)==spval .or. uwnd(i,j)==spval) cycle
2006 absv(i,j) = ((vwnd(ip1,jj)-vwnd(im1,jj))*wrk2(i,jj) &
2007 & + (uwnd(i,jj-1)*cosl(i,jj-1) &
2008 & - uwnd(i,j)*cosl(i,j))*wrk3(i,jj)) * wrk1(i,jj) &
2017 if(vwnd(ip1,j)==spval .or. vwnd(im1,j)==spval .or. &
2018 uwnd(i,j-1)==spval .or. uwnd(i,j+1)==spval) cycle
2019 absv(i,j) = ((vwnd(ip1,j)-vwnd(im1,j))*wrk2(i,j) &
2020 & - (uwnd(i,j-1)*cosl(i,j-1) &
2021 - uwnd(i,j+1)*cosl(i,j+1))*wrk3(i,j)) * wrk1(i,j) &
2036 tx1(i-1) = 0.25 * (tx2(i-1) + tx2(i+1)) + 0.5*tx2(i)
2050 call exch(absv(ista_2l:iend_2u,jsta_2l:jend_2u))
2051 call fullpole(absv(ista_2l:iend_2u,jsta_2l:jend_2u),avpoles)
2054 if(jsta== 1) cosltemp(1:im, 1)=coslpoles(1:im,1)
2055 if(jend==jm) cosltemp(1:im,jm)=coslpoles(1:im,2)
2057 if(jsta== 1) avtemp(1:im, 1)=avpoles(1:im,1)
2058 if(jend==jm) avtemp(1:im,jm)=avpoles(1:im,2)
2060 call poleavg(im,jm,jsta,jend,small,cosltemp(1,jsta),spval,avtemp(1,jsta))
2062 if(jsta== 1) absv(ista:iend, 1)=avtemp(ista:iend, 1)
2063 if(jend==jm) absv(ista:iend,jm)=avtemp(ista:iend,jm)
2065 deallocate (wrk1, wrk2, wrk3, cosl, iw, ie)
2069 IF (gridtype ==
'B')
THEN
2074 CALL dvdxdudy(uwnd,vwnd)
2076 IF(gridtype ==
'A')
THEN
2080 tphi = (j-jmt2)*(dyval/gdsdegr)*dtr
2082 IF(ddvdx(i,j)<spval.AND.ddudy(i,j)<spval.AND. &
2083 uuavg(i,j)<spval.AND.uwnd(i,j)<spval.AND. &
2084 & uwnd(i,j+1)<spval.AND.uwnd(i,j-1)<spval)
THEN
2089 IF(modelname ==
'RAPR' .OR. modelname ==
'FV3R')
then
2090 absv(i,j) = dvdx - dudy + f(i,j)
2092 absv(i,j) = dvdx - dudy + f(i,j) + uavg*tan(gdlat(i,j)*dtr)/erad
2098 ELSE IF (gridtype ==
'E')
THEN
2099 allocate(ihw(jsta_2l:jend_2u), ihe(jsta_2l:jend_2u))
2101 DO j=jsta_2l,jend_2u
2108 tphi = (j-jmt2)*(dyval/1000.)*dtr
2109 tphi = (j-jmt2)*(dyval/gdsdegr)*dtr
2111 IF(vwnd(i+ihe(j),j) < spval.AND.vwnd(i+ihw(j),j) < spval .AND. &
2112 & uwnd(i,j+1) < spval .AND.uwnd(i,j-1) < spval)
THEN
2117 absv(i,j) = dvdx - dudy + f(i,j) + uavg*tan(tphi)/erad
2121 deallocate(ihw, ihe)
2122 ELSE IF (gridtype ==
'B')
THEN
2126 tphi = (j-jmt2)*(dyval/gdsdegr)*dtr
2128 if(vwnd(i, j)==spval .or. vwnd(i, j-1)==spval .or. &
2129 vwnd(i-1,j)==spval .or. vwnd(i-1,j-1)==spval .or. &
2130 uwnd(i, j)==spval .or. uwnd(i-1,j)==spval .or. &
2131 uwnd(i,j-1)==spval .or. uwnd(i-1,j-1)==spval) cycle
2136 absv(i,j) = dvdx - dudy + f(i,j) + uavg*tan(tphi)/erad
2164 SUBROUTINE caldiv(UWND,VWND,DIV)
2165 use masks,
only: gdlat, gdlon
2166 use params_mod,
only: d00, dtr, small, erad
2167 use ctlblk_mod,
only: jsta_2l, jend_2u, spval, modelname, global, &
2168 jsta, jend, im, jm, jsta_m, jend_m, lm, &
2169 ista, iend, ista_m, iend_m, ista_2l, iend_2u
2170 use gridspec_mod,
only: gridtype
2176 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u,lm),
intent(in) :: uwnd,vwnd
2177 REAL,
dimension(ista:iend,jsta:jend,lm),
intent(inout) :: div
2178 REAL,
dimension(IM,2) :: glatpoles, coslpoles, upoles, vpoles, divpoles
2179 REAL,
dimension(IM,JSTA:JEND) :: cosltemp, divtemp
2181 real,
allocatable :: wrk1(:,:), wrk2(:,:), wrk3(:,:), cosl(:,:)
2182 INTEGER,
allocatable :: ihe(:),ihw(:), ie(:),iw(:)
2184 real :: dnpole, dspole, tem
2185 integer i,j,ip1,im1,ii,iir,iil,jj,imb2, l
2192 CALL exch(gdlat(ista_2l,jsta_2l))
2193 CALL exch(gdlon(ista_2l,jsta_2l))
2195 allocate (wrk1(ista:iend,jsta:jend), wrk2(ista:iend,jsta:jend), &
2196 & wrk3(ista:iend,jsta:jend), cosl(ista_2l:iend_2u,jsta_2l:jend_2u))
2197 allocate(iw(im),ie(im))
2214 cosl(i,j) = cos(gdlat(i,j)*dtr)
2215 IF(cosl(i,j) >= small)
then
2216 wrk1(i,j) = 1.0 / (erad*cosl(i,j))
2220 if(i == im .or. i == 1)
then
2221 wrk2(i,j) = 1.0 / ((360.+gdlon(ip1,j)-gdlon(im1,j))*dtr)
2223 wrk2(i,j) = 1.0 / ((gdlon(ip1,j)-gdlon(im1,j))*dtr)
2230 CALL fullpole(gdlat(ista_2l:iend_2u,jsta_2l:jend_2u),glatpoles)
2235 if(gdlat(ista,j) > 0.)
then
2238 if (ii > im) ii = ii - im
2240 wrk3(i,j) = 1.0 / ((180.-gdlat(i,j+1)-glatpoles(ii,1))*dtr)
2245 if (ii > im) ii = ii - im
2247 wrk3(i,j) = 1.0 / ((180.+gdlat(i,j+1)+glatpoles(ii,1))*dtr)
2250 elseif (j == jm)
then
2251 if(gdlat(ista,j) < 0.)
then
2254 if (ii > im) ii = ii - im
2256 wrk3(i,j) = 1.0 / ((180.+gdlat(i,j-1)+glatpoles(ii,2))*dtr)
2261 if (ii > im) ii = ii - im
2263 wrk3(i,j) = 1.0 / ((180.-gdlat(i,j-1)-glatpoles(ii,2))*dtr)
2268 wrk3(i,j) = 1.0 / ((gdlat(i,j-1)-gdlat(i,j+1))*dtr)
2281 CALL exch(vwnd(ista_2l,jsta_2l,l))
2282 CALL exch(uwnd(ista_2l,jsta_2l,l))
2284 CALL fullpole(vwnd(ista_2l:iend_2u,jsta_2l:jend_2u,l),vpoles)
2285 CALL fullpole(uwnd(ista_2l:iend_2u,jsta_2l:jend_2u,l),upoles)
2290 if(gdlat(ista,j) > 0.)
then
2291 IF(cosl(ista,j) >= small)
THEN
2296 if (ii > im) ii = ii - im
2297 div(i,j,l) = ((uwnd(ip1,j,l)-uwnd(im1,j,l))*wrk2(i,j) &
2299 & - (vpoles(ii,1)*coslpoles(ii,1) &
2300 & + vwnd(i,j+1,l)*cosl(i,j+1))*wrk3(i,j)) * wrk1(i,j)
2308 div(i,j,l) = ((uwnd(ip1,jj,l)-uwnd(im1,jj,l))*wrk2(i,jj) &
2309 & + (vwnd(i,j,l)*cosl(i,j) &
2310 - vwnd(i,jj+1,l)*cosl(i,jj+1))*wrk3(i,jj)) * wrk1(i,jj)
2315 IF(cosl(ista,j) >= small)
THEN
2320 if (ii > im) ii = ii - im
2321 div(i,j,l) = ((uwnd(ip1,j,l)-uwnd(im1,j,l))*wrk2(i,j) &
2323 & + (vpoles(ii,1)*coslpoles(ii,1) &
2324 & + vwnd(i,j+1,l)*cosl(i,j+1))*wrk3(i,j)) * wrk1(i,j)
2332 div(i,j,l) = ((uwnd(ip1,jj,l)-uwnd(im1,jj,l))*wrk2(i,jj) &
2333 & - (vwnd(i,j,l)*cosl(i,j) &
2334 - vwnd(i,jj+1,l)*cosl(i,jj+1))*wrk3(i,jj)) * wrk1(i,jj)
2338 ELSE IF(j == jm)
THEN
2339 if(gdlat(ista,j) < 0.)
then
2340 IF(cosl(ista,j) >= small)
THEN
2345 if (ii > im) ii = ii - im
2346 div(i,j,l) = ((uwnd(ip1,j,l)-uwnd(im1,j,l))*wrk2(i,j) &
2347 & + (vwnd(i,j-1,l)*cosl(i,j-1) &
2349 & + vpoles(ii,2)*coslpoles(ii,2))*wrk3(i,j)) * wrk1(i,j)
2357 div(i,j,l) = ((uwnd(ip1,jj,l)-uwnd(im1,jj,l))*wrk2(i,jj) &
2358 & + (vwnd(i,jj-1,l)*cosl(i,jj-1) &
2359 & - vwnd(i,j,l)*cosl(i,j))*wrk3(i,jj)) * wrk1(i,jj)
2364 IF(cosl(ista,j) >= small)
THEN
2369 if (ii > im) ii = ii - im
2370 div(i,j,l) = ((uwnd(ip1,j,l)-uwnd(im1,j,l))*wrk2(i,j) &
2371 & - (vwnd(i,j-1,l)*cosl(i,j-1) &
2373 & + vpoles(ii,2)*coslpoles(ii,2))*wrk3(i,j)) * wrk1(i,j)
2381 div(i,j,l) = ((uwnd(ip1,jj,l)-uwnd(im1,jj,l))*wrk2(i,jj) &
2382 & - (vwnd(i,jj-1,l)*cosl(i,jj-1) &
2383 & - vwnd(i,j,l)*cosl(i,j))*wrk3(i,jj)) * wrk1(i,jj)
2392 div(i,j,l) = ((uwnd(ip1,j,l)-uwnd(im1,j,l))*wrk2(i,j) &
2393 & + (vwnd(i,j-1,l)*cosl(i,j-1) &
2394 - vwnd(i,j+1,l)*cosl(i,j+1))*wrk3(i,j)) * wrk1(i,j)
2402 call exch(div(ista_2l:iend_2u,jsta_2l:jend_2u,l))
2403 call fullpole(div(ista_2l:iend_2u,jsta_2l:jend_2u,l),divpoles)
2406 IF(jsta== 1) cosltemp(1:im, 1)=coslpoles(1:im,1)
2407 IF(jend==jm) cosltemp(1:im,jm)=coslpoles(1:im,2)
2409 IF(jsta== 1) divtemp(1:im, 1)=divpoles(1:im,1)
2410 IF(jend==jm) divtemp(1:im,jm)=divpoles(1:im,2)
2412 call poleavg(im,jm,jsta,jend,small,cosltemp(1:im,jsta:jend) &
2413 ,spval,divtemp(1:im,jsta:jend))
2415 IF(jsta== 1) div(ista:iend, 1,l)=divtemp(ista:iend, 1)
2416 IF(jend==jm) div(ista:iend,jm,l)=divtemp(ista:iend,jm)
2420 deallocate (wrk1, wrk2, wrk3, cosl, iw, ie)
2423 END SUBROUTINE caldiv
2442 SUBROUTINE calgradps(PS,PSX,PSY)
2444 use masks,
only: gdlat, gdlon
2445 use params_mod,
only: dtr, d00, small, erad
2446 use ctlblk_mod,
only: jsta_2l, jend_2u, spval, modelname, global, &
2447 jsta, jend, im, jm, jsta_m, jend_m, &
2448 ista, iend, ista_m, iend_m, ista_2l, iend_2u
2450 use gridspec_mod,
only: gridtype
2456 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(in) :: ps
2457 REAL,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(inout) :: psx,psy
2459 real,
allocatable :: wrk1(:,:), wrk2(:,:), wrk3(:,:), cosl(:,:)
2460 INTEGER,
allocatable :: ihe(:),ihw(:), ie(:),iw(:)
2462 integer i,j,ip1,im1,ii,iir,iil,jj,imb2
2483 CALL exch(gdlat(ista_2l,jsta_2l))
2484 CALL exch(gdlon(ista_2l,jsta_2l))
2486 allocate (wrk1(ista:iend,jsta:jend), wrk2(ista:iend,jsta:jend), &
2487 & wrk3(ista:iend,jsta:jend), cosl(ista_2l:iend_2u,jsta_2l:jend_2u))
2488 allocate(iw(im),ie(im))
2505 cosl(i,j) = cos(gdlat(i,j)*dtr)
2506 if(cosl(i,j) >= small)
then
2507 wrk1(i,j) = 1.0 / (erad*cosl(i,j))
2511 if(i == im .or. i == 1)
then
2512 wrk2(i,j) = 1.0 / ((360.+gdlon(ip1,j)-gdlon(im1,j))*dtr)
2514 wrk2(i,j) = 1.0 / ((gdlon(ip1,j)-gdlon(im1,j))*dtr)
2524 if(gdlat(ista,j) > 0.)
then
2527 if (ii > im) ii = ii - im
2528 wrk3(i,j) = 1.0 / ((180.-gdlat(i,j+1)-gdlat(ii,j))*dtr)
2533 if (ii > im) ii = ii - im
2534 wrk3(i,j) = 1.0 / ((180.+gdlat(i,j+1)+gdlat(ii,j))*dtr)
2537 elseif (j == jm)
then
2538 if(gdlat(ista,j) < 0.)
then
2541 if (ii > im) ii = ii - im
2542 wrk3(i,j) = 1.0 / ((180.+gdlat(i,j-1)+gdlat(ii,j))*dtr)
2547 if (ii > im) ii = ii - im
2548 wrk3(i,j) = 1.0 / ((180.-gdlat(i,j-1)-gdlat(ii,j))*dtr)
2553 wrk3(i,j) = 1.0 / ((gdlat(i,j-1)-gdlat(i,j+1))*dtr)
2561 if(gdlat(ista,j) > 0.)
then
2562 IF(cosl(ista,j) >= small)
THEN
2567 if (ii > im) ii = ii - im
2568 psx(i,j) = (ps(ip1,j)-ps(im1,j))*wrk2(i,j)*wrk1(i,j)
2569 psy(i,j) = (ps(ii,j)-ps(i,j+1))*wrk3(i,j)/erad
2576 psx(i,j) = (ps(ip1,jj)-ps(im1,jj))*wrk2(i,jj)*wrk1(i,jj)
2577 psy(i,j) = (ps(i,j)-ps(i,jj+1))*wrk3(i,jj)/erad
2581 IF(cosl(ista,j) >= small)
THEN
2586 if (ii > im) ii = ii - im
2587 psx(i,j) = (ps(ip1,j)-ps(im1,j))*wrk2(i,j)*wrk1(i,j)
2588 psy(i,j) = - (ps(ii,j)-ps(i,j+1))*wrk3(i,j)/erad
2595 psx(i,j) = (ps(ip1,jj)-ps(im1,jj))*wrk2(i,jj)*wrk1(i,jj)
2596 psy(i,j) = - (ps(i,j)-ps(i,jj+1))*wrk3(i,jj)/erad
2600 ELSE IF(j == jm)
THEN
2601 if(gdlat(ista,j) < 0.)
then
2602 IF(cosl(ista,j) >= small)
THEN
2607 if (ii > im) ii = ii - im
2608 psx(i,j) = (ps(ip1,j)-ps(im1,j))*wrk2(i,j)*wrk1(i,j)
2609 psy(i,j) = (ps(i,j-1)-ps(ii,j))*wrk3(i,j)/erad
2616 psx(i,j) = (ps(ip1,jj)-ps(im1,jj))*wrk2(i,jj)*wrk1(i,jj)
2617 psy(i,j) = (ps(i,jj-1)-ps(i,j))*wrk3(i,jj)/erad
2621 IF(cosl(ista,j) >= small)
THEN
2626 if (ii > im) ii = ii - im
2627 psx(i,j) = (ps(ip1,j)-ps(im1,j))*wrk2(i,j)*wrk1(i,j)
2628 psy(i,j) = - (ps(i,j-1)-ps(ii,j))*wrk3(i,j)/erad
2635 psx(i,j) = (ps(ip1,jj)-ps(im1,jj))*wrk2(i,jj)*wrk1(i,jj)
2636 psy(i,j) = - (ps(i,jj-1)-ps(i,j))*wrk3(i,jj)/erad
2644 psx(i,j) = (ps(ip1,j)-ps(im1,j))*wrk2(i,j)*wrk1(i,j)
2645 psy(i,j) = (ps(i,j-1)-ps(i,j+1))*wrk3(i,j)/erad
2651 deallocate (wrk1, wrk2, wrk3, cosl, iw, ie)
2655 END SUBROUTINE calgradps
2678 SUBROUTINE calslr_roebber(tprs,rhprs,slr)
2680 use masks,
only: lmh
2681 use vrbls2d,
only: slp, avgprec_cont, u10, v10, pshltr, tshltr, qshltr
2682 use vrbls3d,
only: t, q, pmid, pint
2683 use ctlblk_mod,
only: ista, iend, jsta, jend, &
2684 ista_2l, iend_2u, jsta_2l, jend_2u, &
2685 im, jm, lm, lsm, spl, modelname, spval, me, idat
2686 use params_mod,
only: capa, h1, h100
2687 use grib2_module,
only: read_grib2_sngle
2691 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u,lsm),
intent(in) :: tprs
2692 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u,lsm),
intent(in) :: rhprs
2693 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(out) :: slr
2697 character*256 :: climofile
2699 integer :: ntot, height
2700 real,
dimension(im,jm) :: climo
2701 real,
dimension(ista:iend,jsta:jend) :: climosub
2703 real,
dimension(ista:iend,jsta:jend) :: p1d,t1d,q1d,rh1d
2704 real,
dimension(ista:iend,jsta:jend) :: t2m,rh2m
2711 real prob1, prob2, prob3
2712 real,
dimension(0:14),
parameter :: sig = &
2713 (/0.0, 1.0, 0.975, 0.95, 0.925, 0.9, 0.875, 0.85, &
2714 0.8, 0.75, 0.7, 0.65, 0.6, 0.5, 0.4/)
2715 real,
dimension(12),
parameter :: mf = &
2716 (/1.0, 0.67, 0.33, 0.0, -0.33, -0.67, -1.00, -0.67, -0.33, 0.0, 0.33, 0.67/)
2717 integer,
dimension(0:37),
parameter :: levels = &
2718 (/2, 1000, 975, 950, 925, 900, 875, 850, 825, 800, 775, 750, 725, 700, &
2719 675, 650, 625, 600, 575, 550, 525, 500, 475, 450, 425, 400, &
2720 375, 350, 325, 300, 275, 250, 225, 200, 175, 150, 125, 100/)
2722 real,
dimension(0:14) :: tm, rhm
2724 real,
dimension(0:30),
parameter :: co1 = &
2725 (/0.0, -.2926, .0070, -.0099, .0358, .0356, .0353, .0333, .0291, &
2726 .0235, .0169, .0060, -.0009, -.0052, -.0079, -.0093,&
2727 -.0116, -.0137, .0030, .0033, -.0005, -.0024, -.0023,&
2728 -.0021, -.0007, .0013, .0023, .0024, .0012, .0002, -.0010/)
2730 real,
dimension(0:30),
parameter :: co2 = &
2731 (/0.0, -9.7961, .0099, -.0222, -.0036, -.0012, .0010, .0018, .0018,&
2732 .0011, -.0001, -.0016, -.0026, -.0021, -.0015, -.0010,&
2733 -.0008, -.0017, .0238, .0213, .0253, .0232, .0183, .0127,&
2734 .0041, -.0063, -.0088, -.0062, -.0029, .0002, .0019/)
2736 real,
dimension(0:30),
parameter :: co3 = &
2737 (/0.0, 5.0037, -0.0097, -.0130, -.0170, -.0158, -.0141, -.0097,&
2738 -.0034, .0032, .0104, .0200, .0248, .0273, .0280, .0276,&
2739 .0285, .0308, -.0036, -.0042, -.0013, .0011, .0014, .0023,&
2740 .0011, -.0004, -.0022, -.0030, -.0033, -.0031, -.0019/)
2742 real,
dimension(0:30),
parameter :: co4 = &
2743 (/0.0, -5.0141, .0172, -.0267, .0015, .0026, .0033, .0015, -.0007,&
2744 -.0030, -.0063, -.0079, -.0074, -.0055, -.0035, -.0015,&
2745 -.0038, -.0093, .0052, .0059, .0019, -.0022, -.0077, -.0102,&
2746 -.0109, -.0077, .0014, .0160, .0217, .0219, .0190/)
2748 real,
dimension(0:30),
parameter :: co5 = &
2749 (/0.0, -5.2807, -.0240, .0228, .0067, .0019, -.0010, -.0003, .0012,&
2750 .0027, .0056, .0067, .0067, .0034, .0005, -.0026, -.0039,&
2751 -.0033, -.0225, -.0152, -.0157, -.0094, .0049, .0138,&
2752 .0269, .0388, .0334, .0147, .0018, -.0066, -.0112/)
2754 real,
dimension(0:30),
parameter :: co6 = &
2755 (/0.0, -2.2663, .0983, .3666, .0100, .0062, .0020, -.0008, -.0036,&
2756 -.0052, -.0074, -.0086, -.0072, -.0057, -.0040, -.0011,&
2757 .0006, .0014, .0012, -.0005, -.0019, .0003, -.0007, -.0008,&
2758 .0022, .0005, -.0016, -.0052, -.0024, .0008, .0037/)
2760 type(all_grids),
dimension(ista:iend,jsta:jend,0:lsm) :: tmpk_grids, rh_grids
2761 integer,
dimension(ista:iend,jsta:jend,0:lsm) :: tmpk_levels, rh_levels
2763 real,
dimension(ista:iend,jsta:jend) :: hprob,mprob,lprob
2764 real,
dimension(ista:iend,jsta:jend) :: slrgrid, slrgrid2
2765 real,
dimension(ista:iend,jsta:jend) :: psfc,pres,qpf,swnd,prp
2767 character*20 nswfilename
2768 real :: psurf,p,sgw,sg1,sg2,dtds,rhds
2769 real :: f1,f2,f3,f4,f5,f6
2775 integer :: i,j,k,ks,l,ll,imo,iday
2810 psfc(i,j)=pint(i,j,nint(lmh(i,j))+1)
2812 qpf(i,j)=avgprec_cont(i,j)*3600.*3.
2814 IF(u10(i,j)/=spval .AND. v10(i,j)/=spval) &
2815 swnd(i,j)=sqrt(u10(i,j)*u10(i,j)+v10(i,j)*v10(i,j))
2824 IF(modelname==
'RAPR')
THEN
2825 p1d(i,j) = pmid(i,j,nint(lmh(i,j)))
2826 t1d(i,j) = t(i,j,nint(lmh(i,j)))
2828 p1d(i,j) = pint(i,j,lm+1)*exp(-0.068283/tshltr(i,j))
2829 t1d(i,j) = tshltr(i,j)*(pshltr(i,j)*1.e-5)**capa
2831 q1d(i,j) = qshltr(i,j)
2836 CALL calrh(p1d,t1d,q1d,rh1d)
2841 if(qshltr(i,j) /= spval)
then
2842 rh2m(i,j) = min(h100,max(h1,rh1d(i,j)*100.))
2852 tmpk_grids(i,j,0)%grid=t2m(i,j)-273.15
2853 tmpk_levels(i,j,0)=pres(i,j)
2854 rh_grids(i,j,0)%grid=rh2m(i,j)
2855 rh_levels(i,j,0)=pres(i,j)
2866 tmpk_grids(i,j,ll)%grid=tprs(i,j,l)-273.15
2867 tmpk_levels(i,j,ll)=spl(l)
2868 rh_grids(i,j,ll)%grid=rhprs(i,j,l)
2869 rh_levels(i,j,ll)=spl(l)
2876 tmpk_grids(:,:,0)%sigma = 1.0
2877 rh_grids(:,:,0)%sigma = 1.0
2884 if(pres(i,j) == spval)
then
2885 tmpk_grids(i,j,ll)%sigma=spval
2886 rh_grids(i,j,ll)%sigma=spval
2888 tmpk_grids(i,j,ll)%sigma=tmpk_levels(i,j,ll)/pres(i,j)
2889 rh_grids(i,j,ll)%sigma=rh_levels(i,j,ll)/pres(i,j)
2890 prp(i,j)=pres(i,j)/psfc(i,j)
2891 prp(i,j)=prp(i,j)*100000./psfc(i,j)
2910 if(pres(i,j)/=spval .and. qpf(i,j)/=spval .and. swnd(i,j)/=spval)
then
2922 sg1 = tmpk_levels(i,j,ll)/psurf
2924 sg2 = tmpk_levels(i,j,ll+1)/psurf
2927 tm(ks) = tmpk_grids(i,j,ll)%grid
2928 rhm(ks)= rh_grids(i,j,ll)%grid
2929 elseif (sg2 == sgw)
then
2930 tm(ks) = tmpk_grids(i,j,ll+1)%grid
2931 rhm(ks)= rh_grids(i,j,ll+1)%grid
2932 elseif ((sgw < sg1) .and. (sgw > sg2))
then
2933 dtds = (tmpk_grids(i,j,ll+1)%grid - tmpk_grids(i,j,ll)%grid)/(sg2-sg1)
2934 tm(ks) = ((sgw - sg1) * dtds) + tmpk_grids(i,j,ll)%grid
2935 rhds = (rh_grids(i,j,ll+1)%grid - rh_grids(i,j,ll)%grid)/(sg2-sg1)
2936 rhm(ks)= ((sgw - sg1) * rhds) + rh_grids(i,j,ll)%grid
2944 f1 = co1(1)+co1(2)*qpf(i,j)+co1(3)*swnd(i,j)+co1(4)*tm(1)+co1(5)*tm(2)+co1(6)*tm(3)+ &
2945 co1(7)*tm(4)+co1(8)*tm(5)+co1(9)*tm(6)+co1(10)*tm(7)+co1(11)*tm(8)+ &
2946 co1(12)*tm(9)+co1(13)*tm(10)+co1(14)*tm(11)+co1(15)*tm(12)+co1(16)*tm(13)+ &
2947 co1(17)*tm(14)+co1(18)*rhm(1)+co1(19)*rhm(2)+co1(20)*rhm(3)+co1(21)*rhm(4)+ &
2948 co1(22)*rhm(5)+co1(23)*rhm(6)+co1(24)*rhm(7)+co1(25)*rhm(8)+co1(26)*rhm(9)+ &
2949 co1(27)*rhm(10)+co1(28)*rhm(11)+co1(29)*rhm(12)+co1(30)*rhm(13)
2951 f2 = co2(1)+co2(2)*qpf(i,j)+co2(3)*swnd(i,j)+co2(4)*tm(1)+co2(5)*tm(2)+co2(6)*tm(3)+ &
2952 co2(7)*tm(4)+co2(8)*tm(5)+co2(9)*tm(6)+co2(10)*tm(7)+co2(11)*tm(8)+ &
2953 co2(12)*tm(9)+co2(13)*tm(10)+co2(14)*tm(11)+co2(15)*tm(12)+co2(16)*tm(13)+ &
2954 co2(17)*tm(14)+co2(18)*rhm(1)+co2(19)*rhm(2)+co2(20)*rhm(3)+co2(21)*rhm(4)+ &
2955 co2(22)*rhm(5)+co2(23)*rhm(6)+co2(24)*rhm(7)+co2(25)*rhm(8)+co2(26)*rhm(9)+ &
2956 co2(27)*rhm(10)+co2(28)*rhm(11)+co2(29)*rhm(12)+co2(30)*rhm(13)
2958 f3 = co3(1)+co3(2)*qpf(i,j)+co3(3)*swnd(i,j)+co3(4)*tm(1)+co3(5)*tm(2)+co3(6)*tm(3)+ &
2959 co3(7)*tm(4)+co3(8)*tm(5)+co3(9)*tm(6)+co3(10)*tm(7)+co3(11)*tm(8)+ &
2960 co3(12)*tm(9)+co3(13)*tm(10)+co3(14)*tm(11)+co3(15)*tm(12)+co3(16)*tm(13)+ &
2961 co3(17)*tm(14)+co3(18)*rhm(1)+co3(19)*rhm(2)+co3(20)*rhm(3)+co3(21)*rhm(4)+ &
2962 co3(22)*rhm(5)+co3(23)*rhm(6)+co3(24)*rhm(7)+co3(25)*rhm(8)+co3(26)*rhm(9)+ &
2963 co3(27)*rhm(10)+co3(28)*rhm(11)+co3(29)*rhm(12)+co3(30)*rhm(13)
2965 f4 = co4(1)+co4(2)*qpf(i,j)+co4(3)*swnd(i,j)+co4(4)*tm(1)+co4(5)*tm(2)+co4(6)*tm(3)+ &
2966 co4(7)*tm(4)+co4(8)*tm(5)+co4(9)*tm(6)+co4(10)*tm(7)+co4(11)*tm(8)+ &
2967 co4(12)*tm(9)+co4(13)*tm(10)+co4(14)*tm(11)+co4(15)*tm(12)+co4(16)*tm(13)+ &
2968 co4(17)*tm(14)+co4(18)*rhm(1)+co4(19)*rhm(2)+co4(20)*rhm(3)+co4(21)*rhm(4)+ &
2969 co4(22)*rhm(5)+co4(23)*rhm(6)+co4(24)*rhm(7)+co4(25)*rhm(8)+co4(26)*rhm(9)+ &
2970 co4(27)*rhm(10)+co4(28)*rhm(11)+co4(29)*rhm(12)+co4(30)*rhm(13)
2972 f5 = co5(1)+co5(2)*qpf(i,j)+co5(3)*swnd(i,j)+co5(4)*tm(1)+co5(5)*tm(2)+co5(6)*tm(3)+ &
2973 co5(7)*tm(4)+co5(8)*tm(5)+co5(9)*tm(6)+co5(10)*tm(7)+co5(11)*tm(8)+ &
2974 co5(12)*tm(9)+co5(13)*tm(10)+co5(14)*tm(11)+co5(15)*tm(12)+co5(16)*tm(13)+ &
2975 co5(17)*tm(14)+co5(18)*rhm(1)+co5(19)*rhm(2)+co5(20)*rhm(3)+co5(21)*rhm(4)+ &
2976 co5(22)*rhm(5)+co5(23)*rhm(6)+co5(24)*rhm(7)+co5(25)*rhm(8)+co5(26)*rhm(9)+ &
2977 co5(27)*rhm(10)+co5(28)*rhm(11)+co5(29)*rhm(12)+co5(30)*rhm(13)
2979 f6 = co6(1)+co6(2)*qpf(i,j)+co6(3)*swnd(i,j)+co6(4)*tm(1)+co6(5)*tm(2)+co6(6)*tm(3)+ &
2980 co6(7)*tm(4)+co6(8)*tm(5)+co6(9)*tm(6)+co6(10)*tm(7)+co6(11)*tm(8)+ &
2981 co6(12)*tm(9)+co6(13)*tm(10)+co6(14)*tm(11)+co6(15)*tm(12)+co6(16)*tm(13)+ &
2982 co6(17)*tm(14)+co6(18)*rhm(1)+co6(19)*rhm(2)+co6(20)*rhm(3)+co6(21)*rhm(4)+ &
2983 co6(22)*rhm(5)+co6(23)*rhm(6)+co6(24)*rhm(7)+co6(25)*rhm(8)+co6(26)*rhm(9)+ &
2984 co6(27)*rhm(10)+co6(28)*rhm(11)+co6(29)*rhm(12)+co6(30)*rhm(13)
2991 nswfilename=
'Breadboard1.nsw'
2992 call breadboard1_main(nswfilename,mf(imo),f1,f2,f3,f4,f5,f6,p1,p2,p3)
2994 nswfilename=
'Breadboard2.nsw'
2995 call breadboard1_main(nswfilename,mf(imo),f1,f2,f3,f4,f5,f6,p1,p2,p3)
2997 nswfilename=
'Breadboard3.nsw'
2998 call breadboard1_main(nswfilename,mf(imo),f1,f2,f3,f4,f5,f6,p1,p2,p3)
3000 nswfilename=
'Breadboard4.nsw'
3001 call breadboard1_main(nswfilename,mf(imo),f1,f2,f3,f4,f5,f6,p1,p2,p3)
3003 nswfilename=
'Breadboard5.nsw'
3004 call breadboard1_main(nswfilename,mf(imo),f1,f2,f3,f4,f5,f6,p1,p2,p3)
3006 nswfilename=
'Breadboard6.nsw'
3007 call breadboard6_main(nswfilename,mf(imo),f1,f2,f3,f4,f5,f6,p1,p2,p3)
3009 nswfilename=
'Breadboard7.nsw'
3010 call breadboard6_main(nswfilename,mf(imo),f1,f2,f3,f4,f5,f6,p1,p2,p3)
3012 nswfilename=
'Breadboard8.nsw'
3013 call breadboard6_main(nswfilename,mf(imo),f1,f2,f3,f4,f5,f6,p1,p2,p3)
3015 nswfilename=
'Breadboard9.nsw'
3016 call breadboard6_main(nswfilename,mf(imo),f1,f2,f3,f4,f5,f6,p1,p2,p3)
3018 nswfilename=
'Breadboard10.nsw'
3019 call breadboard6_main(nswfilename,mf(imo),f1,f2,f3,f4,f5,f6,p1,p2,p3)
3021 hprob_tot = hprob_tot+p1
3022 mprob_tot = mprob_tot+p2
3023 lprob_tot = lprob_tot+p3
3025 hprob(i,j) = hprob_tot/10.
3026 mprob(i,j) = mprob_tot/10.
3027 lprob(i,j) = lprob_tot/10.
3029 if(hprob(i,j) > mprob(i,j) .and. hprob(i,j) > lprob(i,j))
then
3031 elseif(mprob(i,j) >= hprob(i,j) .and. mprob(i,j) >= lprob(i,j))
then
3033 elseif(lprob(i,j) > hprob(i,j) .and. lprob(i,j) > mprob(i,j))
then
3034 if(lprob(i,j) < .67)
then
3043 if(lprob(i,j) < .67)
then
3044 slrgrid2(i,j) = hprob(i,j)*8.0+mprob(i,j)*13.0+lprob(i,j)*18.0
3045 slrgrid2(i,j) = slrgrid2(i,j)*p/(hprob(i,j)+mprob(i,j)+lprob(i,j))
3047 slrgrid2(i,j) = hprob(i,j)*8.0+mprob(i,j)*13.0+lprob(i,j)*27.0
3048 slrgrid2(i,j) = slrgrid2(i,j)*p/(hprob(i,j)+mprob(i,j)+lprob(i,j))
3053 slr(i,j) = slrgrid2(i,j)
3054 slr(i,j) = max(1.,min(25.,slr(i,j)))
3062 END SUBROUTINE calslr_roebber
3066 SUBROUTINE breadboard1_main(nswFileName,mf,f1,f2,f3,f4,f5,f6,p1,p2,p3)
3070 character*20 nswfilename
3071 real mf, f1, f2, f3, f4, f5, f6
3078 real hidden1axon(40)
3080 real hidden1synapse(7,40)
3081 real outputsynapse(40,3)
3082 real activeoutputprobe(2,3)
3084 real fgrid1(40), fgrid2(3), fgridsum
3105 activeoutputprobe(1,:)=1.
3106 activeoutputprobe(2,:)=0.
3108 if(trim(nswfilename)==
'Breadboard1.nsw')
then
3109 call breadboard1(inputfile,hidden1axon,hidden1synapse,outputsynapse)
3110 elseif(trim(nswfilename)==
'Breadboard2.nsw')
then
3111 call breadboard2(inputfile,hidden1axon,hidden1synapse,outputsynapse)
3112 elseif(trim(nswfilename)==
'Breadboard3.nsw')
then
3113 call breadboard3(inputfile,hidden1axon,hidden1synapse,outputsynapse)
3114 elseif(trim(nswfilename)==
'Breadboard4.nsw')
then
3115 call breadboard4(inputfile,hidden1axon,hidden1synapse,outputsynapse)
3116 elseif(trim(nswfilename)==
'Breadboard5.nsw')
then
3117 call breadboard5(inputfile,hidden1axon,hidden1synapse,outputsynapse)
3120 if(activeoutputprobe(1,1)==1.)
then
3122 activeoutputprobe(1,j)=8.999999761581421e-001
3123 activeoutputprobe(2,j)=5.000000074505806e-002
3130 inputaxon(j) = inputfile(1,j) * f(j) + inputfile(2,j)
3137 fgrid1(j) = fgrid1(j) + hidden1synapse(i,j) * inputaxon(i)
3139 fgrid1(j) = fgrid1(j) + hidden1axon(j)
3140 fgrid1(j) = (exp(fgrid1(j))-exp(-fgrid1(j)))/(exp(fgrid1(j))+exp(-fgrid1(j)))
3147 fgrid2(j) = fgrid2(j) + outputsynapse(i,j) * fgrid1(i)
3149 fgrid2(j) = fgrid2(j) + outputaxon(j)
3150 fgrid2(j) = exp(fgrid2(j))
3151 fgridsum = fgridsum + fgrid2(j)
3154 fgrid2(j) = fgrid2(j) / fgridsum
3162 END SUBROUTINE breadboard1_main
3166 SUBROUTINE breadboard6_main(nswFileName,mf,f1,f2,f3,f4,f5,f6,p1,p2,p3)
3170 character*20 nswfilename
3171 real mf, f1, f2, f3, f4, f5, f6
3181 real hidden1synapse(7,7)
3182 real hidden2synapse(7,4)
3183 real outputsynapse(4,3)
3184 real activeoutputprobe(2,3)
3186 real fgrid1(7), fgrid2(4), fgrid3(3), fgridsum
3207 activeoutputprobe(1,:)=1.
3208 activeoutputprobe(2,:)=0.
3210 if(trim(nswfilename)==
'Breadboard6.nsw')
then
3211 call breadboard6(inputfile,hidden1axon,hidden2axon,&
3212 hidden1synapse,hidden2synapse,outputsynapse)
3213 elseif(trim(nswfilename)==
'Breadboard7.nsw')
then
3214 call breadboard7(inputfile,hidden1axon,hidden2axon,&
3215 hidden1synapse,hidden2synapse,outputsynapse)
3216 elseif(trim(nswfilename)==
'Breadboard8.nsw')
then
3217 call breadboard8(inputfile,hidden1axon,hidden2axon,&
3218 hidden1synapse,hidden2synapse,outputsynapse)
3219 elseif(trim(nswfilename)==
'Breadboard9.nsw')
then
3220 call breadboard9(inputfile,hidden1axon,hidden2axon,&
3221 hidden1synapse,hidden2synapse,outputsynapse)
3222 elseif(trim(nswfilename)==
'Breadboard10.nsw')
then
3223 call breadboard10(inputfile,hidden1axon,hidden2axon,&
3224 hidden1synapse,hidden2synapse,outputsynapse)
3227 if(activeoutputprobe(1,1)==1.)
then
3229 activeoutputprobe(1,j)=8.999999761581421e-001
3230 activeoutputprobe(2,j)=5.000000074505806e-002
3237 inputaxon(j) = inputfile(1,j) * f(j) + inputfile(2,j)
3244 fgrid1(j) = fgrid1(j) + hidden1synapse(i,j) * inputaxon(i)
3246 fgrid1(j) = fgrid1(j) + hidden1axon(j)
3247 fgrid1(j) = (exp(fgrid1(j))-exp(-fgrid1(j)))/(exp(fgrid1(j))+exp(-fgrid1(j)))
3254 fgrid2(j) = fgrid2(j) + hidden2synapse(i,j) * fgrid1(i)
3256 fgrid2(j) = fgrid2(j) + hidden2axon(j)
3257 fgrid2(j) = (exp(fgrid2(j))-exp(-fgrid2(j)))/(exp(fgrid2(j))+exp(-fgrid2(j)))
3264 fgrid3(j) = fgrid3(j) + outputsynapse(i,j) * fgrid2(i)
3266 fgrid3(j) = fgrid3(j) + outputaxon(j)
3267 fgrid3(j) = exp(fgrid3(j))
3268 fgridsum = fgridsum + fgrid3(j)
3271 fgrid3(j) = fgrid3(j) / fgridsum
3279 END SUBROUTINE breadboard6_main
3283 SUBROUTINE breadboard1(inputFile,hidden1Axon,hidden1Synapse,outputSynapse)
3288 real hidden1axon(40)
3289 real hidden1synapse(7,40)
3290 real outputsynapse(40,3)
3292 inputfile = reshape((/ &
3293 1.077844262123108e+00, -1.778443008661270e-01,&
3294 2.295625507831573e-01, 6.163756549358368e-02,&
3295 2.081887423992157e-01, 6.210270524024963e-01,&
3296 3.646677434444427e-01, 1.214343756437302e-01,&
3297 2.430133521556854e-01, 3.004860281944275e-01,&
3298 1.935067623853683e-01, 4.185551702976227e-01,&
3299 1.962280571460724e-01, -4.804643988609314e-01 &
3300 /), shape(inputfile))
3303 (/-1.150484442710876e+00, -1.461968779563904e+00, 1.349107265472412e+00, 6.686212420463562e-01,&
3304 -8.486616015434265e-01, -1.908162593841553e+00, -1.514992356300354e+00, -1.632351636886597e+00,&
3305 -1.794843912124634e+00, 1.354879975318909e+00, 1.389558911323547e+00, 1.464104652404785e+00,&
3306 1.896052122116089e+00, 1.401677846908569e+00, 1.436681509017944e+00, -1.590880393981934e+00,&
3307 -1.070504426956177e+00, 2.047163248062134e+00, 1.564107656478882e+00, 1.298712372779846e+00,&
3308 -1.316817998886108e+00, -1.253177642822266e+00, -1.392926216125488e+00, 7.356406450271606e-01,&
3309 1.594561100006104e+00, -1.532955884933472e+00, -1.021214842796326e+00, 1.341110348701477e+00,&
3310 6.124811172485352e-01, 1.415654063224792e+00, -8.509962558746338e-01, 1.753035664558411e+00,&
3311 6.275475621223450e-01, 1.482843875885010e+00, 1.326028347015381e+00, 1.641556143760681e+00,&
3312 1.339018464088440e+00, -1.374068379402161e+00, -1.220067739486694e+00, 1.714797854423523e+00/)
3314 hidden1synapse = reshape((/ &
3315 -4.612099826335907e-01, -3.177818655967712e-01, -2.800635099411011e-01, -6.984808295965195e-02,&
3316 6.583837419748306e-02, -5.769817233085632e-01, 3.955098092556000e-01, -1.624705344438553e-01,&
3317 -2.889076173305511e-01, -9.411631226539612e-01, -5.058886408805847e-01, -3.110982775688171e-01,&
3318 -3.723000884056091e-01, 8.419776558876038e-01, 2.598794996738434e-01, -1.364605724811554e-01,&
3319 9.416468143463135e-01, -4.025689139962196e-02, 4.176554381847382e-01, 1.196979433298111e-01,&
3320 -3.846398293972015e-01, -1.414917409420013e-01, -2.344214916229248e+00, -3.556166291236877e-01,&
3321 -7.762963771820068e-01, -1.243659138679504e+00, 4.907984733581543e-01, -1.891903519630432e+00,&
3322 -5.802390575408936e-01, -5.546363592147827e-01, -4.520095884799957e-01, -2.473797500133514e-01,&
3323 -7.757837772369385e-01, -5.350160598754883e-01, 1.817676275968552e-01, -1.932217180728912e-01,&
3324 5.944451093673706e-01, -6.568105518817902e-02, -1.562235504388809e-01, 4.926294833421707e-02,&
3325 -6.931540369987488e-01, 7.082754969596863e-01, -3.878217563033104e-02, 5.063381195068359e-01,&
3326 -7.642447352409363e-01, -2.539043128490448e-01, -4.328470230102539e-01, -4.773662984371185e-01,&
3327 6.699458956718445e-01, -1.670347154140472e-01, 6.986252665519714e-01, -6.806275844573975e-01,&
3328 1.059119179844856e-01, 5.320579931139946e-02, -4.806780517101288e-01, 7.601988911628723e-01,&
3329 -1.864496916532516e-01, -3.076690435409546e-01, -6.505665779113770e-01, 7.355872541666031e-02,&
3330 -4.033335149288177e-01, -2.168276757001877e-01, 5.354191064834595e-01, 2.991014420986176e-01,&
3331 4.275756180286407e-01, 6.465418934822083e-01, -1.401910781860352e-01, 5.381527543067932e-01,&
3332 9.247279167175293e-01, -3.687029778957367e-01, 6.354923844337463e-01, -1.423558890819550e-01,&
3333 9.430686831474304e-01, 1.187003701925278e-01, 5.426434278488159e-01, 7.573884129524231e-01,&
3334 3.361994773149490e-02, 3.300542756915092e-02, -4.439333379268646e-01, 5.953744649887085e-01,&
3335 3.412617444992065e-01, 1.421828866004944e-01, 5.224847793579102e-01, -8.267756700515747e-01,&
3336 5.009499788284302e-01, 2.736742198467255e-01, 8.603093624114990e-01, 9.373022615909576e-02,&
3337 1.714528501033783e-01, 9.114132076501846e-02, -1.638108491897583e-01, 5.879403948783875e-01,&
3338 5.585592240095139e-03, 8.149939179420471e-01, -1.340572237968445e-01, 3.880683779716492e-01,&
3339 3.857498764991760e-01, -8.105239868164062e-01, 5.239543914794922e-01, 7.420576363801956e-02,&
3340 7.694411277770996e-01, -3.954831138253212e-02, 5.615213513374329e-01, 4.560695886611938e-01,&
3341 -5.006425976753235e-01, -4.725854694843292e-01, 5.887325108051300e-02, -3.199687898159027e-01,&
3342 -5.229111015796661e-02, -6.034490466117859e-01, -8.414428234100342e-01, 1.826022863388062e-01,&
3343 -6.954011321067810e-01, -5.277091860771179e-01, -9.834931492805481e-01, -2.964940369129181e-01,&
3344 1.752081327140331e-02, -2.412298470735550e-01, 5.861807465553284e-01, 3.650662600994110e-01,&
3345 -1.846716850996017e-01, 3.277707397937775e-01, 1.213769540190697e-01, 1.398152709007263e-01,&
3346 1.624975651502609e-01, -7.172397375106812e-01, -4.065496101975441e-02, -1.131931394338608e-01,&
3347 7.050336003303528e-01, 3.453079611063004e-02, 5.642467141151428e-01, 7.171959280967712e-01,&
3348 -3.295499980449677e-01, 5.192958116531372e-01, 7.558688521385193e-01, 6.164067387580872e-01,&
3349 -1.597565859556198e-01, 1.512383669614792e-01, 5.231227278709412e-01, -2.199545800685883e-01,&
3350 -3.987313508987427e-01, -9.710572957992554e-01, -4.689137935638428e-01, -4.037811756134033e-01,&
3351 -4.528387784957886e-01, -4.784810543060303e-01, 1.759306043386459e-01, 7.449938654899597e-01,&
3352 1.120681285858154e+00, -5.609570741653442e-01, 1.393345594406128e+00, 1.374282408505678e-02,&
3353 -2.458193153142929e-01, 1.237058401107788e+00, -4.854794219136238e-02, -6.664386391639709e-01,&
3354 -8.786886334419250e-01, -3.208510577678680e-01, -4.315690398216248e-01, -5.186472535133362e-01,&
3355 -2.117208093404770e-01, 8.998587727546692e-02, 7.763032317161560e-01, 1.078992128372192e+00,&
3356 3.667660653591156e-01, 5.805531740188599e-01, 1.517073512077332e-01, 9.344519972801208e-01,&
3357 3.396262824535370e-01, 2.450248003005981e-01, 9.134629368782043e-01, 7.127542048692703e-02,&
3358 -1.287281513214111e-01, 3.953699469566345e-01, -4.097535610198975e-01, -5.983641743659973e-01,&
3359 4.500437378883362e-01, -8.147508651018143e-02, -7.916551083326340e-02, -1.505649089813232e-01,&
3360 -1.703914403915405e-01, 1.294612526893616e+00, -4.859757721424103e-01, -1.034098416566849e-01,&
3361 -6.859915256500244e-01, 4.521823674440384e-02, 3.100419938564301e-01, -9.373775720596313e-01,&
3362 5.841451883316040e-01, 7.020491957664490e-01, -1.681403964757919e-01, 6.397892832756042e-01,&
3363 1.168430075049400e-01, 4.124156236648560e-01, 5.404921174049377e-01, -3.311195969581604e-01,&
3364 -3.494578003883362e-01, 1.379718184471130e+00, 2.731607258319855e-01, 5.512273311614990e-01,&
3365 2.997024357318878e-01, 3.475511670112610e-01, 6.777516603469849e-01, 1.471205204725266e-01,&
3366 1.011002138257027e-01, 8.974244594573975e-01, 8.688372373580933e-02, 4.767233729362488e-01,&
3367 9.785303473472595e-01, -2.200428694486618e-01, -6.173372268676758e-01, -8.801369071006775e-01,&
3368 -1.111719012260437e+00, -3.223371803760529e-01, -6.491173505783081e-01, -3.894545435905457e-01,&
3369 -2.843862473964691e-01, 7.331426739692688e-01, -3.287445753812790e-02, -5.741032306104898e-03,&
3370 6.212961673736572e-01, 3.749484941363335e-02, 6.244438700377941e-03, -6.228777766227722e-01,&
3371 -4.667133837938309e-02, 2.016694307327271e+00, 2.834755480289459e-01, 6.229624748229980e-01,&
3372 6.552317738533020e-01, -9.771268069744110e-02, 7.506207823753357e-01, 6.942567825317383e-01,&
3373 -1.662521809339523e-01, 3.003259599208832e-01, -2.531996071338654e-01, 2.399661689996719e-01,&
3374 5.109554529190063e-01, -7.031706571578979e-01, 2.836774885654449e-01, 4.888223409652710e-01,&
3375 1.384589523077011e-01, -3.524579405784607e-01, -2.050135582685471e-01, 1.160808563232422e+00,&
3376 -4.008938968181610e-01, 1.656456440687180e-01, -5.116114616394043e-01, 8.800522685050964e-01,&
3377 6.836380064487457e-02, -5.902936309576035e-02, 5.672354102134705e-01, -7.219299674034119e-01,&
3378 3.463289514183998e-02, -1.044675827026367e+00, -8.341925591230392e-02, -3.036961853504181e-01,&
3379 -5.605638027191162e-01, 5.722484588623047e-01, -1.604338049888611e+00, -5.696258544921875e-01,&
3380 -2.531512081623077e-01, -4.675458073616028e-01, -6.486019492149353e-01, -2.437075823545456e-01,&
3381 -2.898264527320862e-01, 3.836293518543243e-01, 4.061043560504913e-01, 3.909072279930115e-01,&
3382 -8.113911151885986e-01, 1.260317683219910e+00, -3.924282491207123e-01, 3.586370870471001e-02,&
3383 7.703443765640259e-01, 6.714462637901306e-01, -4.909946396946907e-02, 3.536651730537415e-01,&
3384 1.900762617588043e-01, 3.638494014739990e-01, 2.248179465532303e-01, -6.255846619606018e-01 &
3385 /), shape(hidden1synapse))
3387 outputsynapse = reshape((/ &
3388 -4.825605154037476e-01, -1.119017243385315e+00, 5.116804838180542e-01, -6.694142222404480e-01,&
3389 -5.718530416488647e-01, -7.233589291572571e-01, -8.200560212135315e-01, -6.121573448181152e-01,&
3390 -1.034205436706543e+00, 1.015549778938293e+00, 1.183975338935852e+00, 5.342597365379333e-01,&
3391 1.186208128929138e+00, 7.657266259193420e-01, 9.990772604942322e-01, -1.051267385482788e+00,&
3392 -7.288008332252502e-01, 9.447612762451172e-01, 6.943449974060059e-01, 5.248318314552307e-01,&
3393 -1.042970657348633e+00, -4.857340827584267e-04, -8.969252705574036e-01, 5.206210613250732e-01,&
3394 7.825390100479126e-01, -3.175100982189178e-01, -7.697273492813110e-01, 3.042222857475281e-01,&
3395 7.400255203247070e-01, 1.082547545433044e+00, -1.058874249458313e+00, 3.296852707862854e-01,&
3396 9.955985546112061e-01, 7.361931800842285e-01, 8.618848919868469e-01, 7.109408378601074e-01,&
3397 1.148022636771202e-01, -6.803723573684692e-01, -4.462003335356712e-02, 7.384030222892761e-01,&
3398 -2.215545326471329e-01, -8.702403903007507e-01, 8.234908580780029e-01, 6.819239258766174e-01,&
3399 -4.687527120113373e-01, -6.959788203239441e-01, -6.105158329010010e-01, -7.225347757339478e-01,&
3400 -7.860832810401917e-01, 5.608791112899780e-01, 9.937217235565186e-01, 6.797130703926086e-01,&
3401 8.231667280197144e-01, 1.115462303161621e+00, 5.290299654006958e-01, -4.602016210556030e-01,&
3402 -5.394889116287231e-01, 1.053055644035339e+00, 9.533493518829346e-01, 8.694807887077332e-01,&
3403 -4.802323281764984e-01, -1.070514082908630e+00, -8.236010670661926e-01, 7.932062149047852e-01,&
3404 1.111655592918396e+00, -1.025945305824280e+00, -2.268178462982178e-01, 6.432797908782959e-01,&
3405 2.442117929458618e-01, 7.986634969711304e-01, -3.561095297336578e-01, 1.058865070343018e+00,&
3406 6.459046602249146e-01, 4.042869210243225e-01, 2.976681292057037e-02, 1.033244490623474e+00,&
3407 9.110773205757141e-01, -6.528528332710266e-01, -8.971995115280151e-01, 1.046785235404968e+00,&
3408 -5.487565994262695e-01, -1.033755183219910e+00, 5.164890289306641e-01, 1.108534336090088e+00,&
3409 -2.507440149784088e-01, -1.150385260581970e+00, -1.040475010871887e+00, -1.114320755004883e+00,&
3410 -9.695596694946289e-01, 9.147439599037170e-01, 3.035557866096497e-01, 1.044997453689575e+00,&
3411 1.059857130050659e+00, 7.304399013519287e-01, 1.102171182632446e+00, -9.304327964782715e-01,&
3412 -5.997116565704346e-01, 1.120478868484497e+00, 6.444569826126099e-01, 2.137384265661240e-01,&
3413 -4.117920994758606e-01, -1.000458717346191e+00, -2.041520774364471e-01, -1.859422773122787e-01,&
3414 3.711319267749786e-01, -9.141649603843689e-01, -7.499164938926697e-01, 9.900025129318237e-01,&
3415 -2.189985066652298e-01, 8.942219614982605e-01, -3.195305764675140e-01, 6.445295810699463e-01,&
3416 -2.110123336315155e-01, 9.763143658638000e-01, 8.833498954772949e-01, 1.071311354637146e+00,&
3417 1.134591102600098e+00, -4.175429344177246e-01, -6.000540852546692e-01, 7.281569838523865e-01 &
3418 /), shape(outputsynapse))
3420 END SUBROUTINE breadboard1
3424 SUBROUTINE breadboard2(inputFile,hidden1Axon,hidden1Synapse,outputSynapse)
3429 real hidden1axon(40)
3430 real hidden1synapse(7,40)
3431 real outputsynapse(40,3)
3433 inputfile = reshape((/ &
3434 1.077844262123108e+00, -1.778443008661270e-01,&
3435 2.188449800014496e-01, 1.674167998135090e-02,&
3436 1.868382692337036e-01, 6.490761637687683e-01,&
3437 3.361344337463379e-01, 4.151264205574989e-02,&
3438 2.621995508670807e-01, 2.531536519527435e-01,&
3439 1.944894641637802e-01, 3.221717774868011e-01,&
3440 3.179650008678436e-01, -2.033386379480362e-01 &
3441 /), shape(inputfile))
3444 (/-9.235364943742752e-02, -5.511198639869690e-01, 1.012191653251648e+00, -1.148184835910797e-01,&
3445 -8.399781584739685e-01, -4.726789295673370e-01, 7.570160627365112e-01, -3.985013365745544e-01,&
3446 1.164000511169434e+00, 2.212587594985962e-01, 9.570528268814087e-01, -1.504407286643982e+00,&
3447 -1.262813359498978e-01, 9.741528630256653e-01, 2.278975844383240e-01, -3.282702267169952e-01,&
3448 1.716251969337463e-01, 4.979004263877869e-01, 6.414948105812073e-01, -2.775986790657043e-01,&
3449 -6.721665859222412e-01, 7.226511836051941e-01, -1.020949006080627e+00, -9.638186097145081e-01,&
3450 4.050622135400772e-02, -8.287806510925293e-01, -2.900803685188293e-01, 1.004199028015137e+00,&
3451 -1.221053838729858e+00, -5.891714692115784e-01, -6.459002494812012e-01, 8.228222727775574e-01,&
3452 1.921370178461075e-01, 1.575044542551041e-01, -9.904603362083435e-01, 1.186665743589401e-01,&
3453 1.871918141841888e-01, -6.121324300765991e-01, 1.056765243411064e-01, -5.654883384704590e-01/)
3455 hidden1synapse = reshape((/ &
3456 -5.215738341212273e-02, 6.958795785903931e-01, -3.700282871723175e-01, 4.440588057041168e-01,&
3457 -9.248711913824081e-02, 9.709199517965317e-02, 1.255098581314087e-01, -1.359838247299194e-01,&
3458 3.981630802154541e-01, -4.047442674636841e-01, -5.247595906257629e-01, -5.138890147209167e-01,&
3459 2.293408364057541e-01, 5.139534473419189e-01, 2.035804986953735e-01, 3.003124892711639e-01,&
3460 -2.340262830257416e-01, 3.037432730197906e-01, 4.666079878807068e-01, 3.753643631935120e-01,&
3461 -5.292671918869019e-02, 3.674933612346649e-01, 3.854512274265289e-01, 1.749511361122131e-01,&
3462 1.320011764764786e-01, 2.418431788682938e-01, 1.245125234127045e-01, -2.677426636219025e-01,&
3463 3.884479776024818e-02, -1.385747641324997e-01, -3.117613494396210e-01, 3.016934990882874e-01,&
3464 -2.856997251510620e-01, -4.838032424449921e-01, 4.488031566143036e-01, -3.862534165382385e-01,&
3465 2.520084977149963e-01, -6.066129356622696e-02, -2.037643343210220e-01, -9.749407321214676e-02,&
3466 1.909288167953491e-01, -2.689029574394226e-01, 8.022837042808533e-01, 4.543448388576508e-01,&
3467 1.268999278545380e-01, 2.794430553913116e-01, 4.331161379814148e-01, -1.717756092548370e-01,&
3468 -5.167780518531799e-01, 6.074145808815956e-02, 2.141399085521698e-01, -3.536535203456879e-01,&
3469 -2.548796236515045e-01, -4.349331259727478e-01, 3.771509276703000e-03, 1.351494044065475e-01,&
3470 8.080910146236420e-02, -2.638687789440155e-01, 1.792310923337936e-01, -5.317723155021667e-01,&
3471 6.300682574510574e-02, 1.391339004039764e-01, -6.581404209136963e-01, 1.574699729681015e-01,&
3472 -5.979638695716858e-01, -6.864693760871887e-01, -6.892689466476440e-01, -1.189238503575325e-01,&
3473 -1.904999166727066e-01, -4.838389158248901e-01, 4.585682973265648e-02, 3.201213181018829e-01,&
3474 5.204908251762390e-01, -3.531241044402122e-02, 4.392628967761993e-01, 4.307939708232880e-01,&
3475 -4.227218031883240e-02, 1.247199028730392e-01, 1.489800363779068e-01, -3.146159052848816e-01,&
3476 2.637389600276947e-01, -8.966535329818726e-02, 2.010040730237961e-01, 3.161593675613403e-01,&
3477 -8.221558481454849e-02, -4.601925909519196e-01, -3.832246661186218e-01, 2.877672016620636e-01,&
3478 -1.351716276258230e-02, -5.320604424923658e-03, -3.493662178516388e-02, -1.777663826942444e-01,&
3479 -1.865815520286560e-01, 6.387206912040710e-01, -4.405377805233002e-01, 4.452396631240845e-01,&
3480 -1.245370283722878e-01, -2.323225736618042e-01, 1.697962284088135e-01, 1.118463352322578e-01,&
3481 -2.475701570510864e-01, -3.791887685656548e-02, 5.509998202323914e-01, 1.247667223215103e-01,&
3482 3.189268708229065e-01, -3.584641516208649e-01, 8.915060758590698e-01, 9.720049053430557e-02,&
3483 -1.117252558469772e-01, 3.543806076049805e-01, -2.351483702659607e-01, 5.283502340316772e-01,&
3484 1.746209561824799e-01, 1.741478294134140e-01, 2.738423347473145e-01, 3.764865398406982e-01,&
3485 3.486587703227997e-01, -3.462808132171631e-01, 9.324266910552979e-01, 2.155355364084244e-01,&
3486 -5.171442404389381e-02, 6.311618685722351e-01, -1.088170856237411e-01, 4.840107262134552e-01,&
3487 -2.310744374990463e-01, -3.167505562305450e-01, -2.271509468555450e-01, -2.800688743591309e-01,&
3488 4.713648185133934e-02, -1.575807780027390e-01, 3.583298251032829e-02, -3.308865129947662e-01,&
3489 -2.662795484066010e-01, 1.894978582859039e-01, 7.474141567945480e-02, -1.493624746799469e-01,&
3490 -1.482628136873245e-01, -1.058527529239655e-01, -3.737696707248688e-01, -1.093639135360718e-01,&
3491 -4.270362555980682e-01, 1.249950975179672e-01, -1.971846818923950e-01, 3.135327398777008e-01,&
3492 4.604682624340057e-01, -4.614944458007812e-01, 4.820220768451691e-01, 3.806282877922058e-01,&
3493 3.629744052886963e-01, 3.986520171165466e-01, -2.283873707056046e-01, 1.246029064059258e-01,&
3494 3.940442204475403e-01, 2.390366494655609e-01, 8.402416110038757e-02, 3.498363792896271e-01,&
3495 -3.888027667999268e-01, 2.272991091012955e-01, -3.421411216259003e-01, 1.273499727249146e-01,&
3496 1.342627108097076e-01, 1.159043312072754e-01, 1.274240911006927e-01, -2.915177941322327e-01,&
3497 6.415430903434753e-01, 1.699399948120117e-01, -6.556300520896912e-01, 9.605846554040909e-02,&
3498 3.632318377494812e-01, -3.854629993438721e-01, -3.860571384429932e-01, -1.257066577672958e-01,&
3499 -1.186188161373138e-01, -1.368320286273956e-01, -2.300722897052765e-01, -4.762146174907684e-01,&
3500 -3.621844053268433e-01, -4.978014528751373e-02, -1.940275430679321e-01, -1.588442362844944e-02,&
3501 -1.519876420497894e-01, 1.312368810176849e-01, 1.862339228391647e-01, 6.462548375129700e-01,&
3502 5.544137358665466e-01, -3.416634351015091e-02, 9.995899349451065e-02, -6.969342380762100e-02,&
3503 -1.428494304418564e-01, 2.647481858730316e-01, 1.083492934703827e-01, 5.986538901925087e-02,&
3504 -1.576850377023220e-02, 1.962803453207016e-01, 6.334787011146545e-01, -1.408149152994156e-01,&
3505 -1.756295561790466e-01, -2.156554609537125e-01, -1.412229537963867e-01, -5.801249146461487e-01,&
3506 -5.700040608644485e-02, -3.019523918628693e-01, -1.161280944943428e-01, -3.032382726669312e-01,&
3507 1.140000447630882e-01, -2.648598253726959e-01, -2.016042023897171e-01, -3.181084990501404e-02,&
3508 7.931513339281082e-02, 5.399967432022095e-01, -4.595367014408112e-01, 9.602636098861694e-02,&
3509 -4.730868339538574e-01, 2.077568918466568e-01, -2.257115393877029e-01, 3.216529190540314e-01,&
3510 1.631081402301788e-01, 6.222640164196491e-03, -1.323710232973099e-01, 1.348871737718582e-01,&
3511 1.123578473925591e-01, 5.462109446525574e-01, 5.289056897163391e-01, 5.155519247055054e-01,&
3512 2.748569846153259e-01, -3.125837743282318e-01, -3.262098431587219e-01, -8.945185691118240e-03,&
3513 -4.980920553207397e-01, 5.064374208450317e-01, -1.056439951062202e-01, -3.115973472595215e-01,&
3514 3.343601152300835e-02, -7.157339155673981e-02, 5.459919571876526e-01, 2.175374031066895e-01,&
3515 -2.892075665295124e-02, 1.139620468020439e-01, -4.409461319446564e-01, -4.908669367432594e-02,&
3516 -2.098206430673599e-01, 3.024870157241821e-01, -3.447104394435883e-01, -2.666398882865906e-01,&
3517 -1.739841997623444e-01, -1.120999976992607e-01, 4.268572330474854e-01, 4.144327044487000e-01,&
3518 4.936498403549194e-01, 5.718982815742493e-01, 5.464938655495644e-02, 3.950506746768951e-01,&
3519 -1.432464718818665e-01, -8.016809076070786e-02, 5.947722792625427e-01, -1.419431418180466e-01,&
3520 -2.328271418809891e-01, -1.958254128694534e-01, -9.914696216583252e-03, -1.478249877691269e-01,&
3521 4.182004928588867e-01, 7.797469943761826e-02, 3.761124014854431e-01, 4.066407680511475e-01,&
3522 1.217691525816917e-01, -1.124059110879898e-01, 7.020493596792221e-02, 1.022125557065010e-01,&
3523 -5.025411844253540e-01, -2.482684552669525e-01, -5.819427594542503e-02, -1.587846502661705e-02,&
3524 -1.881837695837021e-01, 4.026338756084442e-01, 3.339109122753143e-01, 2.215891182422638e-01,&
3525 7.083265781402588e-01, -7.670203596353531e-02, 3.171359598636627e-01, 8.310161828994751e-01 &
3526 /), shape(hidden1synapse))
3528 outputsynapse = reshape((/ &
3529 2.309078276157379e-01, 8.006124198436737e-02, 5.207773447036743e-01, 3.642434999346733e-02,&
3530 -5.444544181227684e-02, -2.300137132406235e-01, 4.965198636054993e-01, -3.590968847274780e-01,&
3531 1.392439752817154e-01, -2.941058278083801e-01, 6.655657291412354e-01, -4.931978881359100e-01,&
3532 -1.253394484519958e-01, 1.540697813034058e-01, 1.752252578735352e-01, 4.873855113983154e-01,&
3533 5.741749405860901e-01, 1.275441497564316e-01, -4.765471443533897e-02, -5.038099363446236e-02,&
3534 -8.334141224622726e-02, 5.842098593711853e-01, -4.490646719932556e-01, -5.416034907102585e-02,&
3535 -2.264686524868011e-01, -1.698177903890610e-01, 3.113179206848145e-01, 4.435532391071320e-01,&
3536 -5.240975022315979e-01, 1.108570247888565e-01, 2.321150526404381e-02, 2.374080866575241e-01,&
3537 -2.570592761039734e-01, 3.205819129943848e-01, -3.468126952648163e-01, 2.772298157215118e-01,&
3538 1.148034259676933e-01, 1.865169033408165e-03, 3.649827241897583e-01, 5.026416182518005e-01,&
3539 -2.502067089080811e-01, -6.028710007667542e-01, -6.978485733270645e-02, 8.656968921422958e-02,&
3540 -5.227651596069336e-01, 9.525942802429199e-02, -1.903700232505798e-01, 1.426358073949814e-01,&
3541 5.602359771728516e-01, -2.479453980922699e-01, 1.296138316392899e-01, -4.612154662609100e-01,&
3542 -4.198251068592072e-01, 6.053315401077271e-01, -1.160371229052544e-01, -4.044520258903503e-01,&
3543 -1.530461944639683e-02, 4.267008602619171e-01, 2.162231802940369e-01, 1.101492717862129e-01,&
3544 -9.195729345083237e-02, -3.771322593092918e-02, 3.320552408695221e-02, -4.979051947593689e-01,&
3545 1.581449210643768e-01, -5.021102428436279e-01, 1.184114068746567e-02, 4.836803376674652e-01,&
3546 -5.539562702178955e-01, -2.782657444477081e-01, -1.547775119543076e-01, 4.582551419734955e-01,&
3547 2.844007611274719e-01, -4.516306817531586e-01, 1.886052638292313e-02, 3.602048456668854e-01,&
3548 4.175081476569176e-02, 2.075715661048889e-01, -5.455711483955383e-01, -2.442489415407181e-01,&
3549 -2.680016458034515e-01, 2.636941149830818e-03, 4.164874255657196e-01, 8.120876550674438e-02,&
3550 -4.927250146865845e-01, -3.254565298557281e-01, 5.583248138427734e-01, -1.608870923519135e-01,&
3551 5.749610066413879e-01, 5.479150414466858e-01, 3.469662666320801e-01, -5.061987638473511e-01,&
3552 3.353976905345917e-01, 2.548734247684479e-01, 2.064624279737473e-01, -5.114225745201111e-01,&
3553 -4.629626572132111e-01, -1.936426460742950e-01, 2.327886223793030e-01, -4.583241790533066e-02,&
3554 -5.125665068626404e-01, 1.089363321661949e-01, -4.951449036598206e-01, -5.018569827079773e-01,&
3555 2.582837454974651e-02, 4.913705959916115e-02, -2.441505938768387e-01, -3.174663335084915e-02,&
3556 -1.644173413515091e-01, -2.947083115577698e-01, -5.097694396972656e-01, 7.136650383472443e-03,&
3557 1.942666023969650e-01, 1.587397605180740e-01, -4.691866040229797e-01, -4.862202703952789e-01,&
3558 1.432444006204605e-01, -4.405085742473602e-01, 3.072859644889832e-01, -4.172921180725098e-01 &
3559 /), shape(outputsynapse))
3561 END SUBROUTINE breadboard2
3565 SUBROUTINE breadboard3(inputFile,hidden1Axon,hidden1Synapse,outputSynapse)
3570 real hidden1axon(40)
3571 real hidden1synapse(7,40)
3572 real outputsynapse(40,3)
3574 inputfile = reshape((/ &
3575 1.077844262123108e+00, -1.778443008661270e-01,&
3576 2.442665100097656e-01, 3.212104737758636e-02,&
3577 2.107975035905838e-01, 6.168988943099976e-01,&
3578 3.646677434444427e-01, 1.214343756437302e-01,&
3579 2.485501170158386e-01, 2.868268489837646e-01,&
3580 1.976718604564667e-01, 4.469360709190369e-01,&
3581 3.208556175231934e-01, -2.509090602397919e-01 &
3582 /), shape(inputfile))
3585 (/4.393131732940674e-01, -1.290386915206909e-01, 6.327351331710815e-01, 5.494017004966736e-01,&
3586 4.969031810760498e-01, 2.086368650197983e-01, -2.167895883321762e-01, 9.464725255966187e-01,&
3587 1.640024334192276e-01, 2.452306896448135e-01, 1.972979009151459e-01, 9.276027083396912e-01,&
3588 2.502645850181580e-01, 5.485208034515381e-01, -2.839279770851135e-01, 6.810981035232544e-01,&
3589 -2.170253098011017e-01, -3.821973502635956e-01, 8.861125111579895e-01, -6.720829606056213e-01,&
3590 2.960434183478355e-02, -3.987881243228912e-01, -1.057050973176956e-01, 6.963993310928345e-01,&
3591 -1.413413435220718e-01, 7.551014423370361e-01, 1.243001222610474e-02, -3.603826761245728e-01,&
3592 7.450697422027588e-01, 7.630060315132141e-01, 5.904716849327087e-01, -5.035977959632874e-01,&
3593 2.082890830934048e-03, -1.259811818599701e-01, -8.103467822074890e-01, -4.683765172958374e-01,&
3594 -3.666405081748962e-01, -5.880022794008255e-02, -5.269588828086853e-01, -1.594118028879166e-01/)
3596 hidden1synapse = reshape((/ &
3597 2.258135080337524e-01, -8.417334407567978e-02, -6.296884268522263e-02, -1.971755474805832e-01,&
3598 -2.008096426725388e-01, 1.312222182750702e-01, -2.187249064445496e-01, 3.300825655460358e-01,&
3599 -1.458171010017395e-01, -2.447441816329956e-01, 2.373344898223877e-01, -3.369296491146088e-01,&
3600 -2.142974138259888e-01, 7.442125119268894e-03, 2.400149852037430e-01, 5.063241720199585e-01,&
3601 1.461273133754730e-01, 3.199279010295868e-01, 2.184794545173645e-01, 6.378577351570129e-01,&
3602 2.826454937458038e-01, 1.467282772064209e-01, 4.167218208312988e-01, 3.410821408033371e-02,&
3603 -1.507616639137268e-01, 1.607457697391510e-01, 1.063031926751137e-01, 4.860900044441223e-01,&
3604 -7.546984404325485e-02, 3.811344206333160e-01, -3.500247746706009e-02, -3.294828236103058e-01,&
3605 -2.355449087917805e-02, 3.319101631641388e-01, 1.341840159147978e-02, -2.975183129310608e-01,&
3606 -2.044427692890167e-01, 7.903610914945602e-02, -2.241216152906418e-01, -1.982768028974533e-01,&
3607 2.166045308113098e-01, -3.769811093807220e-01, -4.219292849302292e-02, -4.683617055416107e-01,&
3608 1.365721821784973e-01, -5.708352923393250e-01, -5.482509136199951e-01, -5.697317123413086e-01,&
3609 3.948671817779541e-01, 4.008982181549072e-01, -6.056785583496094e-01, -6.540334783494473e-03,&
3610 -4.144128859043121e-01, -9.239719808101654e-02, 1.977843493223190e-01, -2.407579571008682e-01,&
3611 -2.472878843545914e-01, -3.429937064647675e-01, -1.058190166950226e-01, -8.456809073686600e-02,&
3612 4.944565296173096e-01, 4.329789280891418e-01, 2.303941249847412e-01, 2.076211571693420e-01,&
3613 1.421037223190069e-02, 5.740813165903091e-02, 1.577541381120682e-01, 1.072699949145317e-01,&
3614 3.550452180206776e-03, -7.603026926517487e-02, 1.787180006504059e-01, 3.000865578651428e-01,&
3615 -4.790667295455933e-01, -1.263711899518967e-01, -1.886992603540421e-01, -1.971553862094879e-01,&
3616 -4.320513010025024e-01, -1.786982715129852e-01, -3.415124714374542e-01, 3.517304956912994e-01,&
3617 3.841716647148132e-01, 1.595797836780548e-01, 1.466515809297562e-01, 3.235963284969330e-01,&
3618 3.831133618950844e-02, 3.778985887765884e-02, 4.742037355899811e-01, -1.204959601163864e-01,&
3619 -6.766954064369202e-02, 4.763844013214111e-01, 2.847502529621124e-01, -2.614455521106720e-01,&
3620 4.211461246013641e-01, 2.459102123975754e-01, -3.291262984275818e-01, 4.159525930881500e-01,&
3621 1.433917880058289e-01, 5.506788492202759e-01, -4.396528601646423e-01, 3.432570993900299e-01,&
3622 -4.605481028556824e-01, -1.657515168190002e-01, 2.847986221313477e-01, -3.968485295772552e-01,&
3623 2.652311325073242e-01, 2.413431182503700e-03, 6.885899305343628e-01, -1.771224141120911e-01,&
3624 -2.605379931628704e-02, 1.681880354881287e-01, 4.201361536979675e-01, -2.905318737030029e-01,&
3625 -1.065197512507439e-01, 2.377779632806778e-01, 3.171224892139435e-01, -5.171843245625496e-02,&
3626 8.248845487833023e-02, -4.904226213693619e-02, 3.065647780895233e-01, 1.610077768564224e-01,&
3627 8.712385892868042e-01, 3.008154034614563e-01, 5.729283690452576e-01, -1.608658432960510e-01,&
3628 -3.810124993324280e-01, 6.462811827659607e-01, -2.662218213081360e-01, -5.297539830207825e-01,&
3629 -1.356185525655746e-01, 2.623566091060638e-01, -1.624718308448792e-01, -2.004417479038239e-01,&
3630 -3.377428650856018e-02, 3.970716595649719e-01, -1.560127288103104e-01, 4.747187346220016e-02,&
3631 -3.162815868854523e-01, -3.350041508674622e-01, -3.987393081188202e-01, -4.969080090522766e-01,&
3632 -1.142657846212387e-01, -7.119160890579224e-01, 1.153976768255234e-01, -6.001577973365784e-01,&
3633 -3.606468439102173e-01, -3.741255104541779e-01, -7.550917863845825e-01, 1.106901541352272e-01,&
3634 -1.475569456815720e-01, -2.016223073005676e-01, -2.226002812385559e-01, 2.520006597042084e-01,&
3635 -4.015582501888275e-01, -6.874573230743408e-01, -3.860632777214050e-01, 1.074488908052444e-01,&
3636 -3.594025373458862e-01, -2.556712925434113e-01, 2.491754293441772e-01, -1.749203801155090e-01,&
3637 -5.133146420121193e-03, -2.629097700119019e-01, 1.706630140542984e-01, 5.300921797752380e-01,&
3638 3.016012907028198e-01, 3.024738729000092e-01, 1.334729231894016e-02, 3.605858981609344e-01,&
3639 -3.797290921211243e-01, 2.125910073518753e-01, -3.324515819549561e-01, -2.657738924026489e-01,&
3640 8.549436926841736e-02, 2.843597829341888e-01, -1.628004312515259e-01, 4.068509638309479e-01,&
3641 -1.096388697624207e-01, 1.842555999755859e-01, -2.429902255535126e-01, 1.793259531259537e-01,&
3642 6.289024949073792e-01, 4.427114427089691e-01, -8.943214267492294e-02, 1.407862901687622e-01,&
3643 -4.747562706470490e-01, 1.607088744640350e-01, 2.691341638565063e-01, -1.326033025979996e-01,&
3644 -6.888723373413086e-02, 3.347525000572205e-01, 2.391179502010345e-01, -7.601787149906158e-02,&
3645 3.946174979209900e-01, 4.608300328254700e-01, -4.973608553409576e-01, 2.180006355047226e-02,&
3646 -2.155515551567078e-01, 4.018128812313080e-01, 5.872810482978821e-01, -2.970355451107025e-01,&
3647 6.164746284484863e-01, -2.832284271717072e-01, -7.214747369289398e-02, 3.505393862724304e-01,&
3648 3.504253327846527e-01, -3.037774860858917e-01, -3.341494500637054e-01, -2.143821418285370e-01,&
3649 3.230984508991241e-01, -6.691335439682007e-01, -1.196009963750839e-01, 2.609530091285706e-01,&
3650 6.332063078880310e-01, -2.495922595262527e-01, -1.421163380146027e-01, 4.370761811733246e-01,&
3651 2.344440817832947e-01, -4.770855009555817e-01, -1.213536486029625e-01, -4.947537779808044e-01,&
3652 2.018401175737381e-01, -3.219321966171265e-01, -1.836685538291931e-01, 6.838442683219910e-01,&
3653 -5.349717736244202e-01, 5.601373910903931e-01, -3.152181506156921e-01, 2.578000128269196e-01,&
3654 4.295753240585327e-01, -1.423847377300262e-01, 6.693964004516602e-01, -2.671292051672935e-02,&
3655 -2.906464338302612e-01, -6.406581997871399e-01, -5.139582753181458e-01, 2.622411847114563e-01,&
3656 2.534431815147400e-01, -1.518065035343170e-01, -4.292866215109825e-02, 4.628975689411163e-01,&
3657 1.969320774078369e-01, 4.264309704303741e-01, -4.475159347057343e-01, -5.727919340133667e-01,&
3658 5.388451814651489e-01, -2.982297539710999e-01, -3.593768924474716e-02, -1.298359930515289e-01,&
3659 -4.535509645938873e-01, -1.963836848735809e-01, -2.640297412872314e-01, 3.889253437519073e-01,&
3660 -2.371201291680336e-02, 5.441716909408569e-01, -3.557947278022766e-01, -1.912423074245453e-01,&
3661 3.168485462665558e-01, -3.096546828746796e-01, 2.481035888195038e-01, 2.293358147144318e-01,&
3662 -7.027690410614014e-01, -4.839945435523987e-01, -2.963027358055115e-01, -5.126427412033081e-01,&
3663 2.138081789016724e-01, -2.071801871061325e-01, -9.827529639005661e-02, -4.680003225803375e-01,&
3664 -3.230824470520020e-01, -2.535474896430969e-01, 2.779140770435333e-01, -5.119556188583374e-01,&
3665 1.893053054809570e-01, -5.211792513728142e-02, 4.212611019611359e-01, -5.767111182212830e-01,&
3666 3.436119556427002e-01, 1.560586243867874e-01, -1.338404417037964e-01, 2.465801686048508e-01 &
3667 /), shape(hidden1synapse))
3669 outputsynapse = reshape((/ &
3670 -1.504478603601456e-01, 8.304652571678162e-02, 2.053809165954590e-01, 4.613898992538452e-01,&
3671 3.307471871376038e-01, -2.503668665885925e-01, -4.260648787021637e-01, -2.033478170633316e-01,&
3672 1.205723360180855e-01, 3.727485835552216e-01, -2.320208251476288e-01, 4.672348499298096e-01,&
3673 -1.567042618989944e-01, 4.181037843227386e-01, -2.018750756978989e-01, 2.649243474006653e-01,&
3674 2.292609065771103e-01, 2.745892405509949e-01, 2.554303109645844e-01, -3.891312777996063e-01,&
3675 -4.561745524406433e-01, -3.781261444091797e-01, -2.881123721599579e-01, 2.764029800891876e-01,&
3676 8.924255520105362e-02, 4.471623599529266e-01, 9.589984267950058e-02, 4.323486387729645e-01,&
3677 4.792469739913940e-01, -9.918873012065887e-02, 4.427296221256256e-01, 3.841804563999176e-01,&
3678 1.890532523393631e-01, -4.477364718914032e-01, -2.994475699961185e-02, -7.976207137107849e-02,&
3679 2.607934474945068e-01, -3.710708916187286e-01, -2.811897993087769e-01, 6.034602597355843e-02,&
3680 4.014556109905243e-01, 2.982565164566040e-01, 4.447779953479767e-01, -3.612459823489189e-02,&
3681 -2.895380258560181e-01, 2.155442684888840e-01, -3.415147066116333e-01, 4.278375506401062e-01,&
3682 1.896717213094234e-02, -9.841635823249817e-02, 1.671093255281448e-01, 3.151571452617645e-01,&
3683 -1.678100675344467e-01, -4.435905069112778e-02, -2.333792001008987e-01, 4.360995292663574e-01,&
3684 3.587894737720490e-01, -1.017290875315666e-01, 1.382773071527481e-01, -3.980610668659210e-01,&
3685 -2.268472909927368e-01, -2.996328286826611e-02, 2.546367645263672e-01, 1.532198935747147e-01,&
3686 -1.018586382269859e-02, 3.147244155406952e-01, -3.700032234191895e-01, 2.747226655483246e-01,&
3687 4.799823760986328e-01, 3.735623657703400e-01, 3.757937550544739e-01, -5.869687348604202e-02,&
3688 7.807171344757080e-02, -1.428240090608597e-01, -5.030028820037842e-01, -4.323083460330963e-01,&
3689 -2.643692195415497e-01, -4.277939200401306e-01, 3.172474205493927e-01, -4.587580561637878e-01,&
3690 4.488629996776581e-01, -1.273735053837299e-02, 2.275637537240982e-01, 2.276848852634430e-01,&
3691 1.995900124311447e-01, -1.224325075745583e-01, -1.321871429681778e-01, 4.938367307186127e-01,&
3692 3.713837862014771e-01, 4.943797290325165e-01, -8.973516523838043e-02, 3.630679845809937e-01,&
3693 3.118912279605865e-01, 3.763218820095062e-01, -2.658533453941345e-01, 5.210888572037220e-03,&
3694 -3.098636865615845e-01, -4.516429603099823e-01, 3.575363755226135e-01, 3.780608177185059e-01,&
3695 3.606519103050232e-01, 4.404914379119873e-01, -4.452764391899109e-01, 2.741447389125824e-01,&
3696 1.122588440775871e-01, 2.581178247928619e-01, -2.986721992492676e-01, -3.506239950656891e-01,&
3697 -4.466909915208817e-02, 1.343552619218826e-01, -2.677312493324280e-02, -5.070485472679138e-01,&
3698 -5.414816737174988e-01, 3.392856195569038e-02, -4.090670943260193e-01, 2.741051837801933e-02,&
3699 7.242175936698914e-02, 4.587205946445465e-01, -2.530987001955509e-02, 1.304957270622253e-02 &
3700 /), shape(outputsynapse))
3702 END SUBROUTINE breadboard3
3706 SUBROUTINE breadboard4(inputFile,hidden1Axon,hidden1Synapse,outputSynapse)
3711 real hidden1axon(40)
3712 real hidden1synapse(7,40)
3713 real outputsynapse(40,3)
3715 inputfile = reshape((/ &
3716 1.077844262123108e+00, -1.778443008661270e-01,&
3717 2.296211272478104e-01, 6.142363324761391e-02,&
3718 2.128665894269943e-01, 6.552034020423889e-01,&
3719 3.361344337463379e-01, 4.151264205574989e-02,&
3720 2.430133521556854e-01, 3.004860281944275e-01,&
3721 1.976718604564667e-01, 4.469360709190369e-01,&
3722 1.951007992029190e-01, -4.725341200828552e-01 &
3723 /), shape(inputfile))
3726 (/-1.700838446617126e+00, 1.409139156341553e+00, -1.263895153999329e+00, -1.653346180915833e+00,&
3727 -1.753814935684204e+00, 1.510319232940674e+00, -1.652730584144592e+00, 1.968622922897339e+00,&
3728 -1.764715671539307e+00, -1.920537590980530e+00, 1.703584432601929e+00, 9.688673615455627e-01,&
3729 1.621924757957458e+00, -1.195185184478760e+00, -1.170735836029053e+00, -1.726262569427490e+00,&
3730 1.693020582199097e+00, -1.789734363555908e+00, 2.076834440231323e+00, -2.054785251617432e+00,&
3731 1.735462069511414e+00, -1.377997517585754e+00, 1.685962557792664e+00, -1.505226492881775e+00,&
3732 1.329061865806580e+00, -1.970339655876160e+00, 1.326048374176025e+00, -1.803932785987854e+00,&
3733 -1.356570959091187e+00, -7.451403737068176e-01, 1.977797389030457e+00, 1.962222456932068e+00,&
3734 -1.924186825752258e+00, -1.927103757858276e+00, 1.772511124610901e+00, 2.267752170562744e+00,&
3735 1.343345522880554e+00, -1.727791309356689e+00, -1.688525199890137e+00, -2.020093202590942e+00/)
3737 hidden1synapse = reshape((/ &
3738 -3.217298686504364e-01, -1.535140275955200e-01, -9.374593496322632e-01, -3.773699328303337e-02,&
3739 -7.610699534416199e-01, 1.124547328799963e-03, 7.987623810768127e-01, 5.171887874603271e-01,&
3740 1.182283610105515e-01, 1.252476930618286e+00, -2.393243610858917e-01, 8.846385776996613e-02,&
3741 4.983871877193451e-01, -1.072657704353333e+00, -5.902777314186096e-01, 3.053096830844879e-01,&
3742 -1.245228290557861e+00, -9.408684819936752e-02, -1.261333227157593e+00, 7.626018673181534e-02,&
3743 -3.566111624240875e-01, -2.651087939739227e-01, 5.490935966372490e-02, -1.231116533279419e+00,&
3744 -3.552156984806061e-01, -4.995369017124176e-01, -1.970071047544479e-01, 6.921592950820923e-01,&
3745 -7.216929793357849e-01, -3.322352096438408e-02, -1.040984153747559e+00, -2.749272584915161e-01,&
3746 -3.936901688575745e-01, -5.485629439353943e-01, 2.315377295017242e-01, 3.925201594829559e-01,&
3747 2.289973348379135e-01, 9.091649055480957e-01, -2.400987595319748e-01, 2.274930775165558e-01,&
3748 7.657364010810852e-01, -4.531333744525909e-01, -3.045647442340851e-01, -1.612837314605713e-01,&
3749 -6.530205607414246e-01, 6.988145411014557e-02, -3.664937913417816e-01, -1.209497332572937e+00,&
3750 1.716423481702805e-01, 2.888691425323486e-01, -6.977611780166626e-01, 1.001697182655334e+00,&
3751 -3.773393929004669e-01, -3.817198425531387e-02, 3.071420192718506e-01, -1.018374800682068e+00,&
3752 -3.812201619148254e-01, 2.521711289882660e-01, -1.311386704444885e+00, -4.305998682975769e-01,&
3753 -2.096824795007706e-01, -6.536886692047119e-01, 9.946095943450928e-02, -8.006195425987244e-01,&
3754 6.314782798290253e-02, -9.162106513977051e-01, 1.249427199363708e-01, -1.967987567186356e-01,&
3755 -2.837883234024048e-01, 4.405716657638550e-01, 7.357195615768433e-01, 2.873047888278961e-01,&
3756 7.006355524063110e-01, -2.267676740884781e-01, 1.684177815914154e-01, 2.451081871986389e-01,&
3757 -6.897705197334290e-01, -1.359052062034607e-01, -1.217865824699402e+00, 6.268809437751770e-01,&
3758 -1.108817100524902e+00, -1.098538115620613e-01, 6.363938003778458e-02, -2.163156747817993e+00,&
3759 2.993230819702148e-01, -6.225543469190598e-02, 6.338689923286438e-01, 2.340336740016937e-01,&
3760 3.334980309009552e-01, 5.768545866012573e-01, -8.454492688179016e-01, -7.557854652404785e-01,&
3761 -6.227542161941528e-01, -1.105716824531555e+00, 2.116404175758362e-01, -2.117430865764618e-01,&
3762 -1.036560058593750e+00, -1.257222741842270e-01, 5.264365077018738e-01, -1.787502527236938e+00,&
3763 -6.102513074874878e-01, -1.036811590194702e+00, -1.041777491569519e+00, 6.762499362230301e-02,&
3764 -1.829331994056702e+00, -1.342972517013550e-01, 2.181535959243774e+00, 7.125011086463928e-01,&
3765 9.849542975425720e-01, 4.515964090824127e-01, -5.667360424995422e-01, 1.371907234191895e+00,&
3766 4.193291962146759e-01, -4.483173191547394e-01, 1.056447148323059e+00, -4.035096466541290e-01,&
3767 2.473213225603104e-01, 4.283659458160400e-01, -1.105738878250122e+00, -3.882422149181366e-01,&
3768 1.359030008316040e-01, -1.316889882087708e+00, 1.206199750304222e-01, -2.816296517848969e-01,&
3769 -3.856543898582458e-01, -1.341159194707870e-01, 2.931591272354126e-01, -8.115946650505066e-01,&
3770 1.549627929925919e-01, -3.494594991207123e-02, 1.392071247100830e-01, 8.500702381134033e-01,&
3771 -1.105314135551453e+00, -8.855208158493042e-01, -1.129539161920547e-01, -7.288187742233276e-01,&
3772 2.031663209199905e-01, -2.040854692459106e-01, -2.651244997978210e-01, 6.747405529022217e-01,&
3773 6.289814710617065e-01, 3.702930510044098e-01, 8.955963253974915e-01, -1.791490912437439e-01,&
3774 6.291658878326416e-01, 3.181912600994110e-01, -7.458741664886475e-01, -5.797970294952393e-01,&
3775 8.048549294471741e-03, -1.517996788024902e+00, 1.586797833442688e-02, -1.968807131052017e-01,&
3776 -6.696819067001343e-01, 2.561997175216675e-01, 1.585537791252136e-01, -3.939553797245026e-01,&
3777 1.001605153083801e+00, -3.178015723824501e-02, 2.169712930917740e-01, 7.597719430923462e-01,&
3778 -8.711787462234497e-01, -2.590858340263367e-01, -4.994206726551056e-01, -1.350332260131836e+00,&
3779 -1.754350513219833e-01, -5.298053622245789e-01, -1.044484019279480e+00, -5.103482306003571e-02,&
3780 8.845404386520386e-01, 4.584137201309204e-01, 1.076861619949341e+00, 1.874905377626419e-01,&
3781 2.787777185440063e-01, 8.369036912918091e-01, -8.217707276344299e-01, -2.826712131500244e-01,&
3782 -2.450734227895737e-01, -8.279343843460083e-01, 3.510917425155640e-01, -3.488889932632446e-01,&
3783 -7.627615332603455e-01, 3.606846034526825e-01, 5.258455872535706e-01, -5.099301040172577e-02,&
3784 6.352093815803528e-01, -1.835833787918091e-01, 1.247637987136841e+00, 5.917957425117493e-01,&
3785 1.019452288746834e-01, -5.673841834068298e-01, 1.377126276493073e-01, -1.055184245109558e+00,&
3786 -2.036373913288116e-01, -6.316062808036804e-01, -3.354403078556061e-01, 3.826665878295898e-01,&
3787 -6.721435189247131e-01, -6.410418748855591e-01, -1.417969822883606e+00, -8.955898880958557e-02,&
3788 -6.617363095283508e-01, -6.313887238502502e-01, 1.284139454364777e-01, -7.438000291585922e-02,&
3789 3.091568231582642e+00, 8.395515084266663e-01, 7.227233052253723e-01, 8.192335367202759e-01,&
3790 -2.106423974037170e-01, 2.122008800506592e+00, 7.060149908065796e-01, 3.394779860973358e-01,&
3791 6.117095947265625e-01, -3.271679580211639e-01, 1.616740077733994e-01, 1.569840312004089e-01,&
3792 -1.123665213584900e+00, 3.844760954380035e-01, 2.845884263515472e-01, 7.137780785560608e-01,&
3793 1.460106819868088e-01, -1.021391227841377e-01, 5.172263383865356e-01, -7.423986196517944e-01,&
3794 -2.789774909615517e-02, -1.258952766656876e-01, -1.325458526611328e+00, -5.270438194274902e-01,&
3795 -3.967397287487984e-02, -2.709308564662933e-01, 1.340401768684387e-01, -6.963784694671631e-01,&
3796 -3.221498429775238e-01, -8.531031608581543e-01, 3.377375304698944e-01, 1.652107536792755e-01,&
3797 -3.512997031211853e-01, -1.630981415510178e-01, 3.690161705017090e-01, 1.549807284027338e-02,&
3798 1.193455934524536e+00, 2.675475478172302e-01, 3.856497108936310e-01, 9.223973155021667e-01,&
3799 -8.005780726671219e-02, 7.949089407920837e-01, 1.678814589977264e-01, 5.589793920516968e-01,&
3800 -2.890521883964539e-01, -6.459630280733109e-02, 1.577395349740982e-01, -6.019581556320190e-01,&
3801 1.361452788114548e-01, -1.461234450340271e+00, 2.132855653762817e-01, -7.116237878799438e-01,&
3802 -1.837224513292313e-01, 6.981704831123352e-01, -1.456485867500305e+00, -8.896524459123611e-02,&
3803 -6.985316872596741e-01, -9.188821911811829e-01, -1.798982769250870e-01, -3.445543348789215e-01,&
3804 -9.767906665802002e-01, 6.575983762741089e-01, -5.698328614234924e-01, 2.794421613216400e-01,&
3805 -9.889149665832520e-01, 2.113757282495499e-01, -4.894487261772156e-01, -9.110729694366455e-01,&
3806 3.156659901142120e-01, -8.372070193290710e-01, 1.710339263081551e-02, -7.162731885910034e-01,&
3807 -9.848624467849731e-02, -2.407071143388748e-01, -4.630023241043091e-01, 5.028110146522522e-01 &
3808 /), shape(hidden1synapse))
3810 outputsynapse = reshape((/ &
3811 -1.209702730178833e+00, 1.183213353157043e+00, -1.019356846809387e+00, -1.344744205474854e+00,&
3812 -1.445307731628418e+00, 1.024327754974365e+00, -1.584630727767944e+00, 1.083521246910095e+00,&
3813 -1.308865427970886e+00, -1.247952342033386e+00, 1.239847064018250e+00, 1.287056356668472e-01,&
3814 9.846584796905518e-01, -1.553632378578186e+00, -1.231866717338562e+00, 4.489912092685699e-02,&
3815 1.253254055976868e+00, -1.430614471435547e+00, 1.041161060333252e+00, -1.605084300041199e+00,&
3816 1.527578949928284e+00, -1.474965572357178e+00, 1.355290770530701e+00, -1.745877861976624e+00,&
3817 1.712602972984314e+00, -1.563431382179260e+00, 8.333104252815247e-01, -1.541154265403748e+00,&
3818 -1.556280970573425e+00, 7.898001670837402e-01, 1.451943874359131e+00, 1.376102089881897e+00,&
3819 -1.475358963012695e+00, -1.508958697319031e+00, 1.723131775856018e+00, 1.577485084533691e+00,&
3820 2.009120136499405e-01, -1.543342947959900e+00, -1.532042622566223e+00, -1.665173649787903e+00,&
3821 -1.577844977378845e+00, 1.509271860122681e+00, -1.648273229598999e+00, -1.399203181266785e+00,&
3822 -1.230364322662354e+00, 1.090018987655640e+00, -7.097014784812927e-01, 1.677408456802368e+00,&
3823 -1.743194699287415e+00, -1.423129081726074e+00, 7.856354713439941e-01, 1.262704372406006e+00,&
3824 1.029602646827698e+00, -8.157435655593872e-01, -1.168590903282166e+00, -1.007120013237000e+00,&
3825 1.498046159744263e+00, -1.094031929969788e+00, 1.288908720016479e+00, -1.570232629776001e+00,&
3826 1.331548571586609e+00, -1.591911792755127e+00, 1.173869848251343e+00, -1.569446206092834e+00,&
3827 1.071457147598267e+00, -1.386015534400940e+00, 1.319629669189453e+00, -1.251965403556824e+00,&
3828 -1.506981730461121e+00, -5.631150603294373e-01, 1.476744890213013e+00, 1.224819302558899e+00,&
3829 -1.190375804901123e+00, -4.876171946525574e-01, 1.674062848091125e+00, 1.343202710151672e+00,&
3830 8.375900387763977e-01, -1.624152183532715e+00, -1.477828741073608e+00, -1.320914030075073e+00,&
3831 -1.082759499549866e+00, 1.309733152389526e+00, -5.913071632385254e-01, -1.292264103889465e+00,&
3832 -1.440814852714539e+00, 1.020094513893127e+00, -1.208431601524353e+00, 1.691915869712830e+00,&
3833 -1.277797341346741e+00, -1.482174158096313e+00, 1.266713261604309e+00, 1.296367645263672e+00,&
3834 1.238657712936401e+00, -7.025628685951233e-01, 2.491326481103897e-01, -1.536825418472290e+00,&
3835 1.577931523323059e+00, -1.065637469291687e+00, 1.696800708770752e+00, -1.695444345474243e+00,&
3836 1.581656932830811e+00, -1.088520646095276e+00, 1.492973804473877e+00, -1.063908934593201e+00,&
3837 1.496415257453918e+00, -1.486176609992981e+00, 6.039925217628479e-01, -1.485497832298279e+00,&
3838 -1.147870540618896e+00, -1.266431331634521e+00, 1.607187867164612e+00, 1.494379520416260e+00,&
3839 -1.001191616058350e+00, -1.084854602813721e+00, 1.410489916801453e+00, 1.581320643424988e+00,&
3840 1.205576062202454e+00, -1.245357394218445e+00, -1.343545675277710e+00, -1.709581851959229e+00 &
3841 /), shape(outputsynapse))
3843 END SUBROUTINE breadboard4
3847 SUBROUTINE breadboard5(inputFile,hidden1Axon,hidden1Synapse,outputSynapse)
3852 real hidden1axon(40)
3853 real hidden1synapse(7,40)
3854 real outputsynapse(40,3)
3856 inputfile = reshape((/ &
3857 1.077844262123108e+00, -1.778443008661270e-01,&
3858 2.188449800014496e-01, 1.674167998135090e-02,&
3859 1.918158382177353e-01, 6.903452277183533e-01,&
3860 3.361344337463379e-01, 4.151264205574989e-02,&
3861 2.485501170158386e-01, 2.868268489837646e-01,&
3862 1.839550286531448e-01, 3.534696102142334e-01,&
3863 1.951007992029190e-01, -4.725341200828552e-01 &
3864 /), shape(inputfile))
3867 (/3.177257776260376e-01, -3.444353640079498e-01, 5.270494818687439e-01, -5.221590399742126e-01,&
3868 -2.202716171741486e-01, -4.241476655006409e-01, 2.620704658329487e-02, 6.034846901893616e-01,&
3869 -3.619376122951508e-01, -3.380794525146484e-01, 4.901479184627533e-02, 4.951947927474976e-02,&
3870 1.800213754177094e-01, -2.407073378562927e-01, -3.286456167697906e-01, -6.795548200607300e-01,&
3871 -5.868792533874512e-01, -3.454326987266541e-01, 1.429300457239151e-01, -2.292728424072266e-01,&
3872 4.302643239498138e-01, -2.324737906455994e-01, -4.539224207401276e-01, 5.544423460960388e-01,&
3873 -4.054053127765656e-01, -1.476568281650543e-01, -2.141656428575516e-01, 1.077265888452530e-01,&
3874 5.846756696701050e-01, 3.272875547409058e-01, 1.847147941589355e-03, -4.990870654582977e-01,&
3875 1.531988829374313e-01, 1.791626960039139e-01, -6.736395359039307e-01, -5.093495845794678e-01,&
3876 -6.099227815866470e-02, 3.861090838909149e-01, -6.592265367507935e-01, -2.490588128566742e-01/)
3878 hidden1synapse = reshape((/ &
3879 3.541271016001701e-02, -7.549672126770020e-01, -4.738137125968933e-01, -2.348672598600388e-03,&
3880 -2.733762562274933e-01, -8.357829414308071e-03, -8.771334886550903e-01, -2.402636408805847e-01,&
3881 -3.840126693248749e-01, -5.802615284919739e-01, 1.073393039405346e-03, -2.714654207229614e-01,&
3882 -1.682563573122025e-01, 2.412795424461365e-01, 6.722061038017273e-01, -2.907541096210480e-01,&
3883 1.961677670478821e-01, -3.303197622299194e-01, 1.424128562211990e-01, 5.971218943595886e-01,&
3884 -3.415485620498657e-01, -3.709296286106110e-01, 2.636498510837555e-01, -6.461778879165649e-01,&
3885 -4.282482266426086e-01, -1.192058548331261e-01, -7.758595943450928e-01, -4.671352729201317e-02,&
3886 -2.137460708618164e-01, -1.528403162956238e-02, -7.986806631088257e-01, -3.911508247256279e-02,&
3887 -5.328277871012688e-02, -6.519866585731506e-01, 3.402085006237030e-01, 1.100756451487541e-01,&
3888 6.820629835128784e-01, 7.288114726543427e-02, 2.484970390796661e-01, -1.383271068334579e-01,&
3889 1.246754452586174e-01, 6.508666276931763e-01, 3.158373534679413e-01, -5.986170172691345e-01,&
3890 6.103343367576599e-01, -6.012113094329834e-01, -1.359632611274719e-01, -2.586761862039566e-02,&
3891 -4.111338853836060e-01, 1.772232651710510e-01, -6.230232119560242e-01, 3.960133790969849e-01,&
3892 -6.472764015197754e-01, -3.764366805553436e-01, -9.892498701810837e-02, -9.984154999256134e-02,&
3893 -4.294761717319489e-01, -2.304461598396301e-01, -7.071238160133362e-01, -4.068204462528229e-01,&
3894 -4.626799225807190e-01, -3.020684123039246e-01, 6.521416902542114e-01, 1.521919965744019e-01,&
3895 -7.091572284698486e-01, -4.207086861133575e-01, -5.045717954635620e-01, -3.018378615379333e-01,&
3896 -4.485827982425690e-01, -5.111956596374512e-01, -8.567054569721222e-02, 4.856635630130768e-01,&
3897 2.459491789340973e-01, -1.496585756540298e-01, -1.183001995086670e-01, 4.713786244392395e-01,&
3898 -2.809847891330719e-01, 8.547450602054596e-02, -3.530589640140533e-01, -7.254429459571838e-01,&
3899 -1.860966980457306e-01, -6.639543771743774e-01, 4.769657552242279e-01, -7.412918210029602e-01,&
3900 3.024796843528748e-01, -6.272576451301575e-01, -5.452296733856201e-01, -2.242822349071503e-01,&
3901 -3.738160133361816e-01, 3.284691274166107e-01, -4.564896821975708e-01, 2.556349933147430e-01,&
3902 4.318492487072945e-02, -1.320876032114029e-01, -9.898099303245544e-02, 6.774403899908066e-02,&
3903 1.919083893299103e-01, 2.400640696287155e-01, 4.077304899692535e-01, 2.524036169052124e-01,&
3904 5.042297840118408e-01, 2.886471152305603e-01, -1.700776815414429e-01, -2.435589283704758e-01,&
3905 -2.057165205478668e-01, 1.996059715747833e-01, 2.711705565452576e-01, 3.861612975597382e-01,&
3906 -2.083975523710251e-01, 7.296724617481232e-02, -2.396509945392609e-01, -1.525006294250488e-01,&
3907 -4.502384066581726e-01, -5.351938009262085e-01, -3.890139460563660e-01, 1.700514107942581e-01,&
3908 -4.677065312862396e-01, -3.514041006565094e-01, 4.196007549762726e-01, 2.812465429306030e-01,&
3909 -2.938374876976013e-01, -3.160441517829895e-01, -4.980419874191284e-01, 3.127529323101044e-01,&
3910 2.271771281957626e-01, -1.466843336820602e-01, -6.397774219512939e-01, 4.446669816970825e-01,&
3911 8.942086249589920e-02, 9.681937843561172e-02, -5.533168092370033e-02, -4.528337121009827e-01,&
3912 6.882410049438477e-01, -3.133308887481689e-01, -2.058080136775970e-01, -2.226170003414154e-01,&
3913 -2.296325266361237e-01, -2.966837584972382e-01, -3.301460444927216e-01, -3.557955026626587e-01,&
3914 3.304032683372498e-01, -8.399857580661774e-02, 4.199078381061554e-01, 1.194518618285656e-02,&
3915 7.232509851455688e-01, 9.784302115440369e-02, -1.134829670190811e-01, 1.034526005387306e-01,&
3916 -8.523296117782593e-01, 5.190717577934265e-01, 5.323929339647293e-02, 1.697375029325485e-01,&
3917 5.581731796264648e-01, -9.171869754791260e-01, -1.815564483404160e-01, 3.742720186710358e-01,&
3918 -2.523972094058990e-01, 1.490504741668701e-01, -6.334505081176758e-01, 2.519290745258331e-01,&
3919 2.056387513875961e-01, -1.307390183210373e-01, -9.355121254920959e-01, -2.585434913635254e-01,&
3920 -4.636541008949280e-02, -1.257960349321365e-01, 1.712975054979324e-01, -7.756385207176208e-01,&
3921 -2.476336807012558e-01, 2.972539961338043e-01, 4.443784654140472e-01, 4.029458761215210e-02,&
3922 -2.695891633629799e-02, -1.858536303043365e-01, -1.682455986738205e-01, -1.443968862295151e-01,&
3923 3.042537868022919e-01, -4.171138703823090e-01, -1.896526068449020e-01, 1.934753060340881e-01,&
3924 -5.211362838745117e-01, -4.224704951047897e-02, -5.408123731613159e-01, -2.546814382076263e-01,&
3925 -3.727044463157654e-01, -4.361395835876465e-01, 1.507636755704880e-01, 8.203987777233124e-02,&
3926 1.366124451160431e-01, 5.710709095001221e-01, 3.028809726238251e-01, 9.636782407760620e-01,&
3927 -3.770071640610695e-02, 3.973050415515900e-01, 2.884645946323872e-03, -8.364310860633850e-01,&
3928 5.341901779174805e-01, -1.418879022821784e-03, 5.416565537452698e-01, 3.877540528774261e-01,&
3929 -1.585132908076048e-03, 1.770619601011276e-01, 4.701207578182220e-02, 4.187163114547729e-01,&
3930 9.934148788452148e-01, 2.260543704032898e-01, 7.113759517669678e-01, 4.728879332542419e-01,&
3931 -3.471966087818146e-01, 7.732371240854263e-02, -2.182047963142395e-01, 8.698941469192505e-01,&
3932 6.959328651428223e-01, 1.184082403779030e-01, 1.408587545156479e-01, 2.005882859230042e-01,&
3933 3.091167509555817e-01, -1.955157965421677e-01, -2.792426571249962e-02, -7.336559891700745e-02,&
3934 1.834385395050049e-01, -3.164150416851044e-01, -5.837532281875610e-01, 9.843266010284424e-01,&
3935 -5.053303837776184e-01, 9.432902336120605e-01, 2.762463316321373e-02, 3.678649663925171e-01,&
3936 -8.084134012460709e-02, 2.041484862565994e-01, 5.061163306236267e-01, 7.991071939468384e-01,&
3937 2.264233529567719e-01, 7.115226387977600e-01, -5.186138153076172e-01, 4.093891084194183e-01,&
3938 -1.001899018883705e-01, -1.933344826102257e-02, 1.815729439258575e-01, -1.810713559389114e-01,&
3939 -5.504883527755737e-01, 7.005249857902527e-01, -1.967341639101505e-02, 1.448700390756130e-02,&
3940 3.791421651840210e-01, -3.687309324741364e-01, 6.238684058189392e-01, 2.549594640731812e-02,&
3941 6.611171960830688e-01, -2.348230034112930e-01, 4.087108075618744e-01, 1.835047304630280e-01,&
3942 2.745413780212402e-01, -5.477424860000610e-01, 4.227129369974136e-02, 1.370747834444046e-01,&
3943 -1.771535575389862e-01, 2.915630638599396e-01, 8.117929100990295e-02, -5.147354602813721e-01,&
3944 -7.195407748222351e-01, -2.950702905654907e-01, -8.272841572761536e-01, -8.926602080464363e-03,&
3945 6.488984823226929e-01, -7.542604207992554e-01, -1.718278229236603e-01, -4.908424615859985e-02,&
3946 -3.619753718376160e-01, -9.747832268476486e-02, -9.625122696161270e-02, -1.545960754156113e-01,&
3947 4.842050671577454e-01, -9.618758410215378e-02, 1.017526090145111e-01, -1.527849882841110e-01,&
3948 5.150741338729858e-01, -2.614658325910568e-02, -4.681808650493622e-01, 6.698484718799591e-02 &
3949 /), shape(hidden1synapse))
3951 outputsynapse = reshape((/ &
3952 -4.252142608165741e-01, -5.190939903259277e-01, 2.900628745555878e-01, -4.749988615512848e-01,&
3953 -2.432068884372711e-01, 2.475018054246902e-01, 1.508098654448986e-02, -1.032671928405762e-01,&
3954 -5.695398449897766e-01, -4.341589808464050e-01, 3.563072979450226e-01, -1.610363721847534e-01,&
3955 -1.529531776905060e-01, 3.572074323892593e-02, -1.639768481254578e-01, -2.103261351585388e-01,&
3956 -5.111085772514343e-01, -9.769214689731598e-02, -1.570120900869370e-01, -1.928524225950241e-01,&
3957 4.143640100955963e-01, -3.950143232941628e-02, -2.028328180313110e-01, -1.475265175104141e-01,&
3958 -2.296919003129005e-02, -3.979336936026812e-03, -3.908852040767670e-01, 4.192969501018524e-01,&
3959 2.397747188806534e-01, 4.962041378021240e-01, 4.480696618556976e-01, -2.336141020059586e-01,&
3960 3.938802778720856e-01, 2.352581322193146e-01, 1.772783696651459e-02, -5.289353057742119e-02,&
3961 -3.967223316431046e-02, -4.341553747653961e-01, -2.162312269210815e-01, 4.311326891183853e-02,&
3962 4.480128586292267e-01, 1.783114373683929e-01, 5.068565607070923e-01, -4.451447725296021e-01,&
3963 -5.096289515495300e-01, -4.807172119617462e-01, 1.144711822271347e-01, 3.887178003787994e-01,&
3964 -3.575057387351990e-01, -1.148879528045654e-01, -3.399987518787384e-02, -2.313354164361954e-01,&
3965 -7.217752188444138e-02, 3.657472431659698e-01, 3.738324940204620e-01, 4.177713990211487e-01,&
3966 -4.159389436244965e-01, -1.484509706497192e-01, 2.662932872772217e-01, -4.467738270759583e-01,&
3967 7.071519643068314e-02, 3.344006240367889e-01, -5.436876043677330e-02, 3.525221049785614e-01,&
3968 -2.395160868763924e-02, -3.141686320304871e-01, 3.852373957633972e-01, 4.932067096233368e-01,&
3969 -1.492380946874619e-01, 4.595996737480164e-01, 3.445216640830040e-02, -5.653984546661377e-01,&
3970 -4.437799155712128e-01, 1.460446715354919e-01, -4.742037057876587e-01, 1.456019878387451e-01,&
3971 3.867210447788239e-01, 4.871259629726410e-01, -4.954726397991180e-01, 1.770049333572388e-02,&
3972 2.028178423643112e-01, -3.220860958099365e-01, 2.971330881118774e-01, -1.783177554607391e-01,&
3973 -2.126741260290146e-01, -2.823735475540161e-01, 4.713099896907806e-01, 2.155631184577942e-01,&
3974 -3.713304102420807e-01, 2.199546098709106e-01, 2.943331003189087e-01, 4.534626007080078e-01,&
3975 3.414066731929779e-01, -1.535274535417557e-01, -1.036400645971298e-01, -4.483501911163330e-01,&
3976 8.723334968090057e-02, -1.368855964392424e-02, -5.010653138160706e-01, 4.472654759883881e-01,&
3977 1.106471717357635e-01, 5.139253139495850e-01, -2.296521663665771e-01, 4.545788764953613e-01,&
3978 1.664130948483944e-02, 2.438283525407314e-02, -1.943250745534897e-01, 4.952348470687866e-01,&
3979 3.839295804500580e-01, -3.456721901893616e-01, -1.650201976299286e-01, -3.892767727375031e-01,&
3980 -3.154349029064178e-01, 3.591218292713165e-01, -2.804268598556519e-01, -4.606449007987976e-01,&
3981 1.020256653428078e-01, 2.229744791984558e-01, -4.180959761142731e-01, -4.198006689548492e-01 &
3982 /), shape(outputsynapse))
3984 END SUBROUTINE breadboard5
3988 SUBROUTINE breadboard6(inputFile,hidden1Axon,hidden2Axon,&
3989 hidden1Synapse,hidden2Synapse,outputSynapse)
3996 real hidden1synapse(7,7)
3997 real hidden2synapse(7,4)
3998 real outputsynapse(4,3)
4000 inputfile = reshape((/ &
4001 1.353383421897888e+00, -4.533834457397461e-01,&
4002 2.269289046525955e-01, -1.588500849902630e-02,&
4003 1.868382692337036e-01, 6.490761637687683e-01,&
4004 4.038590788841248e-01, 3.776083141565323e-02,&
4005 2.430133521556854e-01, 3.004860281944275e-01,&
4006 1.935067623853683e-01, 4.185551702976227e-01,&
4007 1.951007992029190e-01, -4.725341200828552e-01 &
4008 /), shape(inputfile))
4011 (/ 7.384125608950853e-03, -2.202851057052612e+00, 2.003432661294937e-01, -2.467587143182755e-01,&
4012 5.973502993583679e-01, 3.834692537784576e-01, 2.687855064868927e-01/)
4015 (/ 3.643750846385956e-01, 2.449363768100739e-01, 4.754272103309631e-01, 7.550075054168701e-01/)
4017 hidden1synapse = reshape((/ &
4018 7.333400845527649e-01, 5.450296998023987e-01, -7.700046896934509e-01, 1.426693439483643e+00,&
4019 -1.024212338961661e-03, -6.459779292345047e-02, 1.028800487518311e+00, -2.116347402334213e-01,&
4020 3.591781139373779e+00, 2.435753583908081e+00, -6.687584519386292e-01, 1.201278567314148e+00,&
4021 -3.478864133358002e-01, 1.830960988998413e+00, -3.111673295497894e-01, -4.177703261375427e-01,&
4022 -3.920616805553436e-01, -5.040770769119263e-01, -5.354442000389099e-01, -1.534618530422449e-02,&
4023 -1.089364647865295e+00, -3.010036647319794e-01, 1.486289381980896e+00, 1.059559464454651e+00,&
4024 1.640596628189087e+00, 2.254628390073776e-01, 4.839954376220703e-01, 8.484285473823547e-01,&
4025 -6.926012784242630e-02, 4.926209524273872e-02, 2.834132313728333e-01, 3.028324842453003e-01,&
4026 2.161216735839844e-01, 7.251360416412354e-01, 2.851752638816833e-01, -5.653074979782104e-01,&
4027 3.640621304512024e-01, 1.341893225908279e-01, 7.511208057403564e-01, -1.088509336113930e-01,&
4028 1.044083759188652e-01, 6.529347300529480e-01, -6.885128021240234e-01, -1.003871187567711e-01,&
4029 9.337020665407181e-02, -4.425194561481476e-01, -3.668845295906067e-01, -2.661575675010681e-01,&
4030 -5.936880707740784e-01 &
4031 /), shape(hidden1synapse))
4033 hidden2synapse = reshape((/ &
4034 -5.461466908454895e-01, -1.490996479988098e+00, 7.721499800682068e-01, -3.842977285385132e-01,&
4035 1.134691461920738e-01, -7.171064615249634e-01, 4.990165829658508e-01, -4.233781099319458e-01,&
4036 5.502462983131409e-01, -1.000102013349533e-01, 1.481512188911438e+00, 1.637827455997467e-01,&
4037 5.879161506891251e-02, -3.256742060184479e-01, 4.237195849418640e-01, 1.471476674079895e+00,&
4038 -1.982609331607819e-01, 6.787789463996887e-01, 5.525223612785339e-01, 4.395257532596588e-01,&
4039 1.643348783254623e-01, 8.910947442054749e-01, 1.772162079811096e+00, -2.550726830959320e-01,&
4040 4.305597543716431e-01, 1.965346336364746e-01, -2.251276820898056e-01, -5.650298595428467e-01 &
4041 /), shape(hidden2synapse))
4043 outputsynapse = reshape((/ &
4044 4.605286195874214e-02, 1.636024713516235e-01, 7.045555710792542e-01, 4.994805455207825e-01,&
4045 5.167593955993652e-01, 2.924540340900421e-01, -1.490857079625130e-02, -1.826021969318390e-01,&
4046 3.571106493473053e-01, -3.790216147899628e-01, -6.031348705291748e-01, -4.664786159992218e-01 &
4047 /), shape(outputsynapse))
4049 END SUBROUTINE breadboard6
4053 SUBROUTINE breadboard7(inputFile,hidden1Axon,hidden2Axon,&
4054 hidden1Synapse,hidden2Synapse,outputSynapse)
4061 real hidden1synapse(7,7)
4062 real hidden2synapse(7,4)
4063 real outputsynapse(4,3)
4065 inputfile = reshape((/ &
4066 1.077844262123108e+00, -1.778443008661270e-01,&
4067 2.295625507831573e-01, 6.163756549358368e-02,&
4068 2.081165313720703e-01, 6.204994320869446e-01,&
4069 3.565062582492828e-01, -1.051693689078093e-02,&
4070 2.430133521556854e-01, 3.004860281944275e-01,&
4071 1.839550286531448e-01, 3.534696102142334e-01,&
4072 1.951007992029190e-01, -4.725341200828552e-01 &
4073 /), shape(inputfile))
4076 (/-4.191969335079193e-01, 1.229978561401367e+00, -2.403785735368729e-01, 5.233071446418762e-01,&
4077 8.062141537666321e-01, 1.000604867935181e+00, -1.015548110008240e-01/)
4080 (/-5.321261882781982e-01, -2.396449327468872e+00, -1.170158505439758e+00, -4.097367227077484e-01/)
4082 hidden1synapse = reshape((/ &
4083 1.341468811035156e+00, -4.215665817260742e+00, -1.636691570281982e+00, -2.792109727859497e+00,&
4084 -1.489341259002686e+00, 4.075187742710114e-01, -2.091729402542114e+00, -5.029736161231995e-01,&
4085 -4.151493072509766e+00, -1.452428579330444e+00, 2.398953676223755e+00, -8.748555183410645e-01,&
4086 1.340690374374390e+00, -2.277854681015015e+00, 6.057588458061218e-01, 1.353034019470215e+00,&
4087 -1.214678883552551e+00, -3.864320814609528e-01, 1.148570895195007e+00, 5.792776346206665e-01,&
4088 1.344245020300150e-02, -8.885311484336853e-01, -1.594583272933960e+00, 4.960928857326508e-01,&
4089 -1.118881464004517e+00, -2.252289772033691e+00, 6.328870654106140e-01, -1.946701169013977e+00,&
4090 -2.910976111888885e-01, 2.447998225688934e-01, 2.001658976078033e-01, -1.229660585522652e-02,&
4091 6.969845890998840e-01, -5.897524300962687e-03, -5.688555836677551e-01, 2.619750201702118e-01,&
4092 -4.162483692169189e+00, -1.468571424484253e+00, -3.118389844894409e+00, 6.947994828224182e-01,&
4093 -2.687734663486481e-01, -2.110401153564453e+00, 3.224660456180573e-02, 8.378994464874268e-01,&
4094 9.896742701530457e-01, -7.354493737220764e-01, 6.684727072715759e-01, 1.465887904167175e+00,&
4095 -3.726872503757477e-01 &
4096 /), shape(hidden1synapse))
4098 hidden2synapse = reshape((/ &
4099 -3.395457863807678e-01, -5.815528631210327e-01, 2.929831743240356e-01, -5.629656314849854e-01,&
4100 4.701104387640953e-02, -9.300172328948975e-01, -1.461120098829269e-01, -3.458845615386963e-01,&
4101 1.266251802444458e-01, 6.342335790395737e-02, 1.869771480560303e-01, -1.476681977510452e-01,&
4102 5.144428834319115e-02, -3.145390946883708e-04, 8.697064518928528e-01, 1.057970225811005e-01,&
4103 2.603019773960114e-01, 4.393529295921326e-01, -2.832717299461365e-01, 5.771816968917847e-01,&
4104 -3.896601796150208e-01, -7.260112762451172e-01, -7.957320213317871e-01, 6.776907294988632e-02,&
4105 -3.073690235614777e-01, -1.540119051933289e-01, -6.733091473579407e-01, 2.009786069393158e-01 &
4106 /), shape(hidden2synapse))
4108 outputsynapse = reshape((/ &
4109 3.156347572803497e-01, -8.236174583435059e-01, -9.946570396423340e-01, 4.212915897369385e-01,&
4110 -7.918102145195007e-01, -2.033229321241379e-01, -1.056663155555725e+00, -5.699685215950012e-01,&
4111 -9.666987657546997e-01, -5.505290031433105e-01, 8.724089711904526e-02, -9.536570906639099e-01 &
4112 /), shape(outputsynapse))
4114 END SUBROUTINE breadboard7
4118 SUBROUTINE breadboard8(inputFile,hidden1Axon,hidden2Axon,&
4119 hidden1Synapse,hidden2Synapse,outputSynapse)
4126 real hidden1synapse(7,7)
4127 real hidden2synapse(7,4)
4128 real outputsynapse(4,3)
4130 inputfile = reshape((/ &
4131 1.353383421897888e+00, -4.533834457397461e-01,&
4132 2.188449800014496e-01, 1.674167998135090e-02,&
4133 1.906577646732330e-01, 6.807435750961304e-01,&
4134 3.361344337463379e-01, 4.151264205574989e-02,&
4135 2.491349428892136e-01, 3.307266235351562e-01,&
4136 1.839550286531448e-01, 3.534696102142334e-01,&
4137 1.951007992029190e-01, -4.725341200828552e-01 &
4138 /), shape(inputfile))
4141 (/-3.274627029895782e-01, 2.668272238224745e-03, -3.019839525222778e-01, -4.557206928730011e-01,&
4142 -5.515558272600174e-02, 3.119016764685512e-04, 8.753398060798645e-02/)
4145 (/ 2.733168303966522e-01, -3.423235416412354e-01, 8.666662573814392e-01, -6.124708056449890e-01/)
4147 hidden1synapse = reshape((/ &
4148 2.732226848602295e-01, 1.847893238067627e+00, -1.084923520684242e-01, 1.385403037071228e+00,&
4149 2.885355055332184e-01, -3.135629594326019e-01, 1.057805895805359e+00, -5.868541821837425e-02,&
4150 3.278825521469116e+00, 4.641786217689514e-01, 4.461606740951538e-01, -1.952850073575974e-01,&
4151 -5.789646506309509e-01, 1.945697903633118e+00, -9.578172862529755e-02, 2.150904417037964e+00,&
4152 9.114052653312683e-01, 1.107189536094666e+00, 6.752110123634338e-01, 2.475811988115311e-01,&
4153 1.050705909729004e+00, 3.205673992633820e-01, 2.478840798139572e-01, -5.084273815155029e-01,&
4154 -2.407394796609879e-01, -1.702371835708618e-01, 1.456947028636932e-01, 3.221787512302399e-01,&
4155 -2.719256579875946e-01, -5.116361379623413e-01, 3.973563387989998e-02, -1.733802706003189e-01,&
4156 -1.649789661169052e-01, -4.471102654933929e-01, -4.071239829063416e-01, -1.492276042699814e-01,&
4157 -1.245773434638977e+00, -6.851593255996704e-01, -8.733592033386230e-01, -4.348643422126770e-01,&
4158 -3.520536422729492e-01, -9.930510520935059e-01, 1.956800930202007e-02, -9.781590104103088e-01,&
4159 -6.039583683013916e-01, -6.923800706863403e-01, -6.682770848274231e-01, 4.162513464689255e-02,&
4160 -1.004322052001953e+00 &
4161 /), shape(hidden1synapse))
4163 hidden2synapse = reshape((/ &
4164 -8.183520436286926e-01, -1.621446132659912e+00, -1.045793533325195e+00, -5.855653062462807e-02,&
4165 4.404523968696594e-01, 7.002395391464233e-01, 2.097517400979996e-01, -9.925779700279236e-02,&
4166 -8.263560533523560e-01, -1.043026208877563e+00, 4.524357020854950e-01, 2.231711596250534e-01,&
4167 8.736496567726135e-01, 8.797182440757751e-01, 6.963157653808594e-01, 2.816314399242401e-01,&
4168 1.525615751743317e-01, 1.936565339565277e-01, 1.900831162929535e-01, 1.180221140384674e-01,&
4169 1.027775928378105e-01, 9.149055480957031e-01, 1.129598617553711e+00, 6.131598353385925e-01,&
4170 2.547058761119843e-01, 2.556352131068707e-02, -3.627143800258636e-02, -6.722733378410339e-01 &
4171 /), shape(hidden2synapse))
4173 outputsynapse = reshape((/ &
4174 -5.266965627670288e-01, -1.973343640565872e-01, 1.362649053335190e-01, 9.479679167270660e-02,&
4175 2.987665235996246e-01, -3.116582632064819e-01, -1.842434853315353e-01, -4.986568093299866e-01,&
4176 6.261917948722839e-01, 5.454919338226318e-01, -3.484728187322617e-02, -4.687039256095886e-01 &
4177 /), shape(outputsynapse))
4179 END SUBROUTINE breadboard8
4183 SUBROUTINE breadboard9(inputFile,hidden1Axon,hidden2Axon,&
4184 hidden1Synapse,hidden2Synapse,outputSynapse)
4191 real hidden1synapse(7,7)
4192 real hidden2synapse(7,4)
4193 real outputsynapse(4,3)
4195 inputfile = reshape((/ &
4196 1.077844262123108e+00, -1.778443008661270e-01,&
4197 2.188449800014496e-01, 1.674167998135090e-02,&
4198 1.868382692337036e-01, 6.490761637687683e-01,&
4199 3.733665347099304e-01, 1.051026657223701e-01,&
4200 2.430133521556854e-01, 3.004860281944275e-01,&
4201 2.083092182874680e-01, 3.581876754760742e-01,&
4202 1.951007992029190e-01, -4.725341200828552e-01 &
4203 /), shape(inputfile))
4206 (/ 1.012814998626709e+00, -3.782782554626465e-01, -2.220184087753296e+00, -3.424299955368042e-01,&
4207 1.449530482292175e+00, -2.592789530754089e-01, -4.670010507106781e-01/)
4210 (/ 3.516010642051697e-01, 3.293374776840210e-01, -1.675553172826767e-01, 3.799068629741669e-01/)
4212 hidden1synapse = reshape((/ &
4213 1.390573829412460e-01, -3.110583126544952e-01, 1.105552077293396e+00, 4.394045472145081e-01,&
4214 4.795211851596832e-01, 1.969023197889328e-01, 5.574952811002731e-02, 1.690310984849930e-01,&
4215 2.208244323730469e+00, 2.111947536468506e+00, 3.239532709121704e-01, 7.690296173095703e-01,&
4216 1.264077782630920e+00, 1.672740578651428e+00, 1.320844173431396e+00, 7.965675592422485e-01,&
4217 -7.341063618659973e-01, 3.702043294906616e+00, 1.716022133827209e+00, -6.642882823944092e-01,&
4218 1.686427950859070e+00, -4.863217473030090e-01, 1.285641908645630e+00, 1.281449794769287e+00,&
4219 2.356275558471680e+00, -1.406845331192017e+00, 6.027717590332031e-01, 6.652191877365112e-01,&
4220 -9.871492385864258e-01, -5.513690948486328e+00, -2.750334143638611e-01, 1.229651212692261e+00,&
4221 -2.504641294479370e+00, -3.219850361347198e-01, -2.744197607040405e+00, -4.023179113864899e-01,&
4222 9.932321496307850e-03, -6.916724443435669e-01, -2.260914087295532e+00, 1.261568814516068e-01,&
4223 3.248662948608398e-01, 6.963043808937073e-01, 1.830800414085388e+00, -2.054267644882202e+00,&
4224 -9.595731496810913e-01, -8.711494207382202e-01, -1.330682396888733e+00, 2.109736204147339e+00,&
4225 -6.145163774490356e-01 &
4226 /), shape(hidden1synapse))
4228 hidden2synapse = reshape((/ &
4229 -3.299105465412140e-01, 4.235435724258423e-01, 9.191738963127136e-01, 6.795659661293030e-01,&
4230 -1.440919041633606e+00, 4.634908214211464e-02, -1.265781879425049e+00, 2.394487708806992e-01,&
4231 1.205053567886353e+00, 5.790516138076782e-01, 1.087130665779114e+00, -6.723164916038513e-01,&
4232 -1.834900081157684e-01, -4.767680168151855e-01, 8.402896672487259e-02, 1.035530328750610e+00,&
4233 1.644443035125732e+00, 4.317290484905243e-01, -1.714672803878784e+00, 5.225644707679749e-01,&
4234 -5.602287650108337e-01, 1.068559288978577e+00, -2.211284125223756e-03, -2.943626642227173e-01,&
4235 1.341261714696884e-01, 4.324447214603424e-01, -5.482236146926880e-01, -4.985276758670807e-01 &
4236 /), shape(hidden2synapse))
4238 outputsynapse = reshape((/ &
4239 3.726457059383392e-01, 7.749153375625610e-01, 4.159255921840668e-01, 5.234625935554504e-01,&
4240 -1.592817008495331e-01, 5.884559154510498e-01, -7.756121158599854e-01, 2.137655019760132e-01,&
4241 -6.172903776168823e-01, -4.417923986911774e-01, -4.576872885227203e-01, 4.440903961658478e-01 &
4242 /), shape(outputsynapse))
4244 END SUBROUTINE breadboard9
4248 SUBROUTINE breadboard10(inputFile,hidden1Axon,hidden2Axon,&
4249 hidden1Synapse,hidden2Synapse,outputSynapse)
4256 real hidden1synapse(7,7)
4257 real hidden2synapse(7,4)
4258 real outputsynapse(4,3)
4260 inputfile = reshape((/ &
4261 1.077844262123108e+00, -1.778443008661270e-01,&
4262 2.269289046525955e-01, -1.588500849902630e-02,&
4263 1.906577646732330e-01, 6.807435750961304e-01,&
4264 3.703703582286835e-01, -4.592590779066086e-02,&
4265 2.611723542213440e-01, 3.901915252208710e-01,&
4266 1.911842674016953e-01, 4.027296602725983e-01,&
4267 1.951007992029190e-01, -4.725341200828552e-01 &
4268 /), shape(inputfile))
4271 (/ 1.307985544204712e+00, -1.960705667734146e-01, -1.105142459273338e-01, -1.207442641258240e+00,&
4272 -1.665081620216370e+00, 1.251117825508118e+00, -7.307677268981934e-01/)
4275 (/ 2.186001092195511e-02, 3.369570672512054e-01, 1.165086925029755e-01, 2.747000660747290e-03/)
4277 hidden1synapse = reshape((/ &
4278 -3.375437259674072e-01, -3.020816326141357e+00, -1.435481071472168e+00, 1.473870635032654e+00,&
4279 -7.776365280151367e-01, 6.734371185302734e-01, -1.643768787384033e+00, -1.227448821067810e+00,&
4280 -7.365036606788635e-01, -4.473563134670258e-01, -5.696173906326294e-01, -2.562220990657806e-01,&
4281 8.557485342025757e-01, -8.057124614715576e-01, 4.266147911548615e-01, 2.171551227569580e+00,&
4282 3.776189982891083e-01, 5.574828386306763e-01, 3.814708292484283e-01, 2.591066062450409e-01,&
4283 1.959651827812195e+00, 1.003962755203247e-01, -1.228965446352959e-02, -3.882043361663818e-01,&
4284 -2.722288109362125e-02, -3.378733694553375e-01, -7.981095314025879e-01, 4.839731752872467e-01,&
4285 1.432798147201538e+00, 1.885666996240616e-01, -6.051751971244812e-01, 2.924412488937378e+00,&
4286 1.136252880096436e+00, 2.994727194309235e-01, 1.604383468627930e+00, -8.440219759941101e-01,&
4287 6.088087558746338e-01, -3.722844421863556e-01, 5.441566109657288e-01, 3.944540619850159e-01,&
4288 7.044004201889038e-01, 3.459328413009644e-01, 1.054268121719360e+00, -3.348083496093750e+00,&
4289 -7.199336886405945e-01, -1.489133596420288e+00, -4.090557992458344e-01, 8.203456401824951e-01,&
4290 -1.118073821067810e+00 &
4291 /), shape(hidden1synapse))
4293 hidden2synapse = reshape((/ &
4294 -6.871775984764099e-01, -1.148896694183350e+00, -2.102893590927124e-01, -5.890849828720093e-01,&
4295 5.899340510368347e-01, 7.098034024238586e-01, -1.422515869140625e+00, -1.206974506378174e+00,&
4296 4.104525446891785e-01, 3.567897081375122e-01, 2.746991515159607e-01, 1.193219542503357e+00,&
4297 3.167707324028015e-01, -1.222744822502136e+00, -9.918631613254547e-02, 4.355156719684601e-01,&
4298 2.938420772552490e-01, -1.012830615043640e+00, -1.290418803691864e-01, 7.479285597801208e-01,&
4299 -2.292920649051666e-01, -1.372484922409058e+00, -6.534293759614229e-03, 1.525195717811584e+00,&
4300 2.076585590839386e-01, 1.434590101242065e+00, 7.887706905603409e-02, -1.401232123374939e+00 &
4301 /), shape(hidden2synapse))
4303 outputsynapse = reshape((/ &
4304 6.101396083831787e-01, 3.122945129871368e-01, 3.869898915290833e-01, 4.438063502311707e-01,&
4305 5.161536335945129e-01, -2.700618803501129e-01, -3.105166740715504e-02, -5.569267272949219e-01,&
4306 -5.549081563949585e-01, -3.867979049682617e-01, 1.623111665248871e-01, -6.052750945091248e-01 &
4307 /), shape(outputsynapse))
4309 END SUBROUTINE breadboard10
4347 SUBROUTINE calslr_uutah(SLR)
4349 use vrbls3d,
only: zint,zmid,pmid,t,q,uh,vh
4350 use masks,
only: lmh,htm
4351 use ctlblk_mod,
only: ista,iend,jsta,jend,ista_2l,iend_2u,jsta_2l,jend_2u,&
4356 real,
dimension(ista_2l:iend_2u,jsta_2l:jend_2u),
intent(out) :: slr
4358 integer,
parameter :: nfl=3
4359 real,
parameter :: htfl(nfl)=(/ 500., 1000., 2000. /)
4360 real,
dimension(ISTA:IEND,JSTA:JEND,NFL) :: tfd,ufd,vfd
4362 real lhl(nfl),dzabh(nfl),swnd(nfl)
4363 real htsfc,htabh,dz,rdz,delt,delu,delv
4365 real,
parameter :: m1 = -0.174848
4366 real,
parameter :: m2 = -0.52644
4367 real,
parameter :: m3 = 0.034911
4368 real,
parameter :: m4 = -0.270473
4369 real,
parameter :: m5 = 0.028299
4370 real,
parameter :: m6 = 0.096273
4371 real,
parameter :: b =118.35844
4373 integer,
dimension(ISTA:IEND,JSTA:JEND) :: karr
4374 integer,
dimension(ISTA:IEND,JSTA:JEND) :: twet05
4375 real,
dimension(ISTA:IEND,JSTA:JEND) :: zwet
4377 REAL,
ALLOCATABLE :: twet(:,:,:)
4379 integer i,j,l,llmh,lmhk,ifd
4383 ALLOCATE(twet(ista_2l:iend_2u,jsta_2l:jend_2u,lm))
4389 tfd(i,j,ifd) = spval
4390 ufd(i,j,ifd) = spval
4391 vfd(i,j,ifd) = spval
4401 IF(zint(i,j,lm+1)<spval)
THEN
4402 htsfc = zint(i,j,lm+1)
4403 llmh = nint(lmh(i,j))
4406 htabh = zmid(i,j,l)-htsfc
4407 IF(htabh>htfl(ifd))
THEN
4409 dzabh(ifd) = htabh-htfl(ifd)
4419 IF (l<lm .AND. t(i,j,l)<spval .AND. uh(i,j,l)<spval .AND. vh(i,j,l)<spval)
THEN
4420 dz = zmid(i,j,l)-zmid(i,j,l+1)
4422 delt = t(i,j,l)-t(i,j,l+1)
4423 tfd(i,j,ifd) = t(i,j,l) - delt*rdz*dzabh(ifd)
4424 delu = uh(i,j,l)-uh(i,j,l+1)
4425 delv = vh(i,j,l)-vh(i,j,l+1)
4426 ufd(i,j,ifd) = uh(i,j,l) - delu*rdz*dzabh(ifd)
4427 vfd(i,j,ifd) = vh(i,j,l) - delv*rdz*dzabh(ifd)
4429 tfd(i,j,ifd) = t(i,j,l)
4430 ufd(i,j,ifd) = uh(i,j,l)
4431 vfd(i,j,ifd) = vh(i,j,l)
4445 IF(tfd(i,j,1)<spval .AND. ufd(i,j,1)<spval .AND. vfd(i,j,1)<spval)
THEN
4446 swnd(1)=sqrt(ufd(i,j,1)*ufd(i,j,1)+vfd(i,j,1)*vfd(i,j,1))
4447 swnd(2)=sqrt(ufd(i,j,2)*ufd(i,j,2)+vfd(i,j,2)*vfd(i,j,2))
4448 swnd(3)=sqrt(ufd(i,j,3)*ufd(i,j,3)+vfd(i,j,3)*vfd(i,j,3))
4449 slr(i,j) = m1*swnd(2)+m2*tfd(i,j,3)+m3*swnd(3)+m4*swnd(1)+m5*tfd(i,j,2)+m6*tfd(i,j,1)+b
4450 slr(i,j) = max(slr(i,j),3.)
4458 CALL wetbulb(t,q,pmid,htm,karr,twet)
4463 zwet(i,j)=zmid(i,j,lm)
4472 IF(twet05(i,j) < 0)
THEN
4473 IF(twet(i,j,l) <= 273.15+0.5)
THEN
4474 zwet(i,j)=zmid(i,j,l)
4485 IF(twet05(i,j) > 0 .AND. slr(i,j)<spval)
THEN
4486 htabh=zwet(i,j)-zint(i,j,lm+1)
4487 IF(htabh<0.) htabh=0.
4488 slr(i,j)=slr(i,j)*(1.-htabh/200.)
4489 IF(slr(i,j)<0.) slr(i,j)=0.
4496 END SUBROUTINE calslr_uutah
4500 end module upp_physics
subroutine exch(a)
exch() Subroutine that exchanges one halo row.
subroutine fullpole(a, rpoles)
fullpole()