hdiff output

r29757/MLP3.f90 2016-01-18 10:30:10.216958467 +0000 r29756/MLP3.f90 2016-01-18 10:30:10.420961166 +0000
  1: SUBROUTINE MLP3(X,V,ENERGY,GTEST,SECT)  1: svn: E195012: Unable to find repository location for 'svn+ssh://svn.ch.private.cam.ac.uk/groups/wales/trunk/OPTIM/source/MLP3.f90' in revision 29756
  2: USE KEY 
  3: USE MODHESS 
  4: USE COMMONS, ONLY : DEBUG 
  5: IMPLICIT NONE 
  6: LOGICAL GTEST,SECT 
  7: DOUBLE PRECISION X(NMLP), V(NMLP), ENERGY, DUMMY1, DUMMY2, DUMMY3, DUMMY4 
  8: DOUBLE PRECISION Y(MLPOUT), PROB(MLPOUT), PMLPOUTJ1 
  9: DOUBLE PRECISION DYW1G(MLPHIDDEN), DPCW1BG(MLPOUT,MLPHIDDEN) 
 10: DOUBLE PRECISION DYW2G(MLPOUT,MLPHIDDEN,MLPIN), DPCW2BG(MLPHIDDEN,MLPIN), TANHSUM(MLPHIDDEN), SECH2(MLPHIDDEN) 
 11: INTEGER MLPOUTJ1, MLPOFFSET 
 12: INTEGER GETUNIT, LUNIT, J1, J2, J3, J4, K4, K2, K3, J5 
 13:  
 14: ! 
 15: ! Variables are ordered  
 16: ! w^2_{jk} at (j-1)*MLPIN+k 
 17: !   up to MLPHIDDEN*MLPIN, then 
 18: ! w^1_{ij} at MLPHIDDEN*MLPIN + (i-1)*MLPHIDDEN+j 
 19: !   up to MLPHIDDEN*MLPIN + MLPOUT*MLPHIDDEN 
 20: ! 
 21:  
 22: MLPOFFSET=MLPHIDDEN*MLPIN 
 23: ENERGY=0.0D0 
 24: V(1:NMLP)=0.0D0 
 25: IF (SECT) HESS(1:NMLP,1:NMLP)=0.0D0 
 26: DO J1=1,MLPDATA 
 27:    MLPOUTJ1=MLPOUTCOME(J1) 
 28:    DO J2=1,MLPHIDDEN 
 29:       DUMMY1=0.0D0 
 30:       DO J3=1,MLPIN 
 31:          DUMMY1=DUMMY1+X((J2-1)*MLPIN+J3)*MLPDAT(J1,J3) 
 32:       ENDDO 
 33:       TANHSUM(J2)=TANH(DUMMY1)  
 34:       DYW1G(J2)=TANHSUM(J2) 
 35:       SECH2(J2)=1.0D0/COSH(DUMMY1)**2  
 36:    ENDDO 
 37:    DUMMY3=0.0D0 
 38:    DO J4=1,MLPOUT 
 39:       DUMMY2=0.0D0 
 40:       DO J2=1,MLPHIDDEN 
 41:          DO J3=1,MLPIN 
 42:             DYW2G(J4,J2,J3)=X( MLPOFFSET + (J4-1)*MLPHIDDEN + J2 ) * MLPDAT(J1,J3)*SECH2(J2) 
 43:          ENDDO 
 44:          DUMMY2=DUMMY2+X(MLPOFFSET+(J4-1)*MLPHIDDEN+J2)*TANHSUM(J2) 
 45:       ENDDO 
 46:       Y(J4)=DUMMY2 
 47:       DUMMY3=DUMMY3+EXP(DUMMY2) 
 48:    ENDDO   
 49:    DO J4=1,MLPOUT 
 50:       PROB(J4)=EXP(Y(J4))/DUMMY3 
 51:    ENDDO 
 52:    PMLPOUTJ1=PROB(MLPOUTJ1) 
 53: !  IF (DEBUG) THEN 
 54: !     WRITE(*,'(A,I8,A)') 'MLP3> data point ',J1,' outputs and probabilities:' 
 55: !     WRITE(*,'(8G15.5)') Y(1:MLPOUT),PROB(1:MLPOUT) 
 56: !  ENDIF 
 57:    ENERGY=ENERGY-LOG(PMLPOUTJ1) 
 58:    IF (GTEST) THEN 
 59: ! 
 60: ! We only need the probability derivative for the probability corresponding to the correct outcome for this data point 
 61: ! 
 62:       DPCW1BG(1:MLPOUT,1:MLPHIDDEN)=0.0D0 
 63:       DO J2=1,MLPHIDDEN 
 64:          DO J4=1,MLPOUT 
 65:             DPCW1BG(J4,J2)=DPCW1BG(J4,J2)-PMLPOUTJ1*PROB(J4)*DYW1G(J2) 
 66:          ENDDO 
 67:          DPCW1BG(MLPOUTJ1,J2)=DPCW1BG(MLPOUTJ1,J2)+PMLPOUTJ1*DYW1G(J2) 
 68:       ENDDO 
 69:  
 70:       DO J3=1,MLPIN 
 71:          DO J2=1,MLPHIDDEN 
 72:             DUMMY3=0.0D0 
 73:             DO J4=1,MLPOUT 
 74:                DUMMY3=DUMMY3+PROB(J4)*DYW2G(J4,J2,J3) 
 75:             ENDDO 
 76:             DPCW2BG(J2,J3)=PMLPOUTJ1*(DYW2G(MLPOUTJ1,J2,J3)-DUMMY3) 
 77:          ENDDO 
 78:       ENDDO 
 79:  
 80:       DO J4=1,MLPOUT 
 81:          DO J2=1,MLPHIDDEN 
 82:             V(MLPOFFSET+(J4-1)*MLPHIDDEN+J2)=V(MLPOFFSET+(J4-1)*MLPHIDDEN+J2)-DPCW1BG(J4,J2)/PMLPOUTJ1 
 83:          ENDDO 
 84:       ENDDO 
 85:  
 86:       DO J3=1,MLPIN 
 87:          DO J2=1,MLPHIDDEN 
 88:             V((J2-1)*MLPIN+J3)=V((J2-1)*MLPIN+J3)-DPCW2BG(J2,J3)/PMLPOUTJ1 
 89:          ENDDO 
 90:       ENDDO 
 91:    ENDIF 
 92:    IF (SECT) THEN 
 93: ! 
 94: ! This block w^1 with w^1 is locally symmetric 
 95: ! 
 96:       DO J4=1,MLPOUT ! J4 is beta  
 97:          DO J2=1,MLPHIDDEN ! J2 is gamma 
 98:             DO K4=1,J4 ! K4 is alpha 
 99:                DO K2=1,MLPHIDDEN ! K2 is epsilon 
100:                   DUMMY1=0.0D0 
101:                   IF ((J4.EQ.MLPOUTJ1).AND.(K4.EQ.MLPOUTJ1)) DUMMY1=1.0D0 
102:                   IF (J4.EQ.MLPOUTJ1) DUMMY1=DUMMY1-PROB(K4) 
103:                   IF (K4.EQ.MLPOUTJ1) DUMMY1=DUMMY1-PROB(J4) 
104:                   IF (K4.EQ.J4) DUMMY1=DUMMY1-PROB(J4) 
105:                   DUMMY1=DUMMY1+2.0D0*PROB(J4)*PROB(K4) 
106:                   HESS(MLPOFFSET+(J4-1)*MLPHIDDEN+J2,MLPOFFSET+(K4-1)*MLPHIDDEN+K2)= & 
107:   &               HESS(MLPOFFSET+(J4-1)*MLPHIDDEN+J2,MLPOFFSET+(K4-1)*MLPHIDDEN+K2) & ! sum over data points 
108:   &               +DPCW1BG(J4,J2)*DPCW1BG(K4,K2)/PMLPOUTJ1**2 & 
109:   &               -DUMMY1*TANHSUM(J2)*TANHSUM(K2) 
110:                ENDDO 
111:             ENDDO 
112:          ENDDO 
113:       ENDDO 
114: ! 
115: ! Off-diagonal w^1 with w^2 blocks 
116: ! 
117:       DO J3=1,MLPOUT ! J3 is beta for w^1 outputs 
118:          DO J2=1,MLPHIDDEN ! J2 is gamma for w^1 hidden 
119:             DO K4=1,MLPHIDDEN ! K4 is alpha for w^2 hidden 
120:                DUMMY3=0.0D0 
121:                DO J5=1,MLPOUT 
122:                   DUMMY3=DUMMY3+PROB(J5)*X(MLPOFFSET + (J5-1)*MLPHIDDEN + K4)  
123:                ENDDO 
124:                DO K2=1,MLPIN ! K2 is epsilon for w^2 inputs 
125:                   DUMMY1=0.0D0 
126:                   IF (K4.EQ.J2) DUMMY1=DUMMY1-PMLPOUTJ1*PROB(J3)*MLPDAT(J1,K2)*SECH2(J2) 
127:                   IF ((K4.EQ.J2).AND.(J3.EQ.MLPOUTJ1)) DUMMY1=DUMMY1+PMLPOUTJ1*MLPDAT(J1,K2)*SECH2(J2) 
128:  
129:                   DUMMY2=TANHSUM(J2)*PMLPOUTJ1*MLPDAT(J1,K2)*SECH2(K4) & 
130:   &                      *(X(MLPOFFSET+(MLPOUTJ1-1)*MLPHIDDEN+K4)-DUMMY3) 
131:                   DUMMY1=DUMMY1-PROB(J3)*DUMMY2 
132:                   IF (MLPOUTJ1.EQ.J3) DUMMY1=DUMMY1+DUMMY2 
133:                   DUMMY1=DUMMY1-PMLPOUTJ1*PROB(J3)*MLPDAT(J1,K2)*SECH2(K4)*TANHSUM(J2) & 
134:   &                             *(X(MLPOFFSET + (J3-1)*MLPHIDDEN + K4)-DUMMY3) 
135:                   HESS(MLPOFFSET+(J3-1)*MLPHIDDEN+J2,(K4-1)*MLPIN+K2)= & 
136:   &               HESS(MLPOFFSET+(J3-1)*MLPHIDDEN+J2,(K4-1)*MLPIN+K2) & ! sum over data points 
137:   &               +DPCW1BG(J3,J2)*DPCW2BG(K4,K2)/PMLPOUTJ1**2 & 
138:   &               -DUMMY1/PMLPOUTJ1 
139:                ENDDO 
140:             ENDDO 
141:          ENDDO 
142:       ENDDO 
143: ! 
144: ! diagonal w^2 with w^2  
145: ! 
146:       DO J3=1,MLPIN ! J3 is gamma for w^2 inputs 
147:          DO J2=1,MLPHIDDEN ! J2 is beta for w^2 hidden 
148:             DUMMY2=0.0D0 
149:             DO J5=1,MLPOUT 
150:                DUMMY2=DUMMY2+PROB(J5)*X(MLPOFFSET + (J5-1)*MLPHIDDEN + J2)  
151:             ENDDO 
152:             DO K4=1,MLPIN ! K4 is epsilon for w^2 inputs 
153:                DO K2=1,J2 ! K2 is alpha for w^2 hidden 
154:                   DUMMY3=0.0D0 
155:                   DO J5=1,MLPOUT 
156:                      DUMMY3=DUMMY3+PROB(J5)*X(MLPOFFSET + (J5-1)*MLPHIDDEN + K2)  
157:                   ENDDO 
158:                   DUMMY4=0.0D0 
159:                   DO J5=1,MLPOUT 
160:                      DUMMY4=DUMMY4+PROB(J5)*X(MLPOFFSET + (J5-1)*MLPHIDDEN + K2)  & ! take out of loops 
161:   &                                        *X(MLPOFFSET + (J5-1)*MLPHIDDEN + J2) 
162:                   ENDDO 
163:                   DUMMY1=DPCW2BG(K2,K4)*MLPDAT(J1,J3)*SECH2(J2) & 
164:   &                      *(X(MLPOFFSET+(MLPOUTJ1-1)*MLPHIDDEN+J2)-DUMMY2) & 
165:   &                      -PMLPOUTJ1*MLPDAT(J1,J3)*SECH2(J2)*MLPDAT(J1,K4)*SECH2(K2) & 
166:   &                      *(DUMMY4-DUMMY2*DUMMY3) 
167:                   IF (K2.EQ.J2) DUMMY1=DUMMY1-2.0D0*PMLPOUTJ1*MLPDAT(J1,K4)*MLPDAT(J1,J3) & 
168:   &                                     *SECH2(J2)*TANHSUM(J2)*(X(MLPOFFSET + (MLPOUTJ1-1)*MLPHIDDEN + J2)-DUMMY2)  
169:  
170:                   HESS((J2-1)*MLPIN+J3,(K2-1)*MLPIN+K4)= & 
171:   &               HESS((J2-1)*MLPIN+J3,(K2-1)*MLPIN+K4) & ! sum over data points 
172:   &               +DPCW2BG(J2,J3)*DPCW2BG(K2,K4)/PMLPOUTJ1**2 - DUMMY1/PMLPOUTJ1 
173:                ENDDO 
174:             ENDDO 
175:          ENDDO 
176:       ENDDO 
177:    ENDIF 
178: ENDDO 
179:  
180: DUMMY1=0.0D0 
181: DO J1=1,NMLP 
182:    DUMMY1=DUMMY1+X(J1)**2 
183: ENDDO 
184:  
185: ENERGY=ENERGY/MLPDATA + MLPLAMBDA*DUMMY1 
186: ! IF (DEBUG) WRITE(*,'(A,G20.10)') 'MLP3> objective function=',ENERGY 
187:  
188: IF (GTEST) V(1:NMLP)=V(1:NMLP)/MLPDATA + 2.0D0*MLPLAMBDA*X(1:NMLP) 
189: ! 
190: ! Symmetrise Hessian here 
191: ! 
192: IF (SECT) HESS(1:NMLP,1:NMLP)=HESS(1:NMLP,1:NMLP)/MLPDATA 
193: IF (SECT) THEN 
194:    DO J1=1,NMLP 
195:       HESS(J1,J1)=HESS(J1,J1)+2*MLPLAMBDA 
196:       DO J2=1,J1-1 
197:          HESS(J2,J1)=HESS(J1,J2) 
198:       ENDDO 
199:    ENDDO 
200: ENDIF 
201:  
202: END SUBROUTINE MLP3 


legend
Lines Added 
Lines changed
 Lines Removed

hdiff - version: 2.1.0