 |
Millepede-II
V04-00-00
|
|
Millepede-II
V04-00-00
|
00001 00002 ! Code converted using TO_F90 by Alan Miller 00003 ! Date: 2012-03-03 Time: 17:00:12 00004 00007 00010 00013 00016 00064 00065 SUBROUTINE MILLE(nlc,derlc,ngl,dergl,label,rmeas,sigma) ! add data 00066 IMPLICIT NONE 00067 INTEGER :: i 00068 INTEGER :: icount 00069 INTEGER :: isp 00070 INTEGER :: nr 00071 INTEGER :: nsp 00072 ! ----------------------------------------------------------------- 00073 00074 INTEGER, INTENT(IN) :: nlc 00075 REAL, INTENT(IN) :: derlc(nlc) 00076 INTEGER, INTENT(IN) :: ngl 00077 REAL, INTENT(IN) :: dergl(ngl) 00078 INTEGER, INTENT(IN) :: label(ngl) 00079 REAL, INTENT(IN) :: rmeas 00080 REAL, INTENT(IN) :: sigma 00081 INTEGER, PARAMETER :: lun=51 00082 INTEGER, PARAMETER :: ndim=10000 00083 REAL :: glder(ndim) ! real data record array 00084 INTEGER :: inder(ndim) ! integer data record array 00085 ! ----------------------------------------------------------------- 00086 00087 SAVE 00088 DATA nr/0/ ! initial record length 00089 DATA icount/0/ 00090 ! ... 00091 IF(sigma <= 0.0) RETURN ! error zero - no measurement 00092 IF(nr == 0) THEN 00093 nr=1 00094 glder(1)=0.0 00095 inder(1)=0 ! error counter 00096 isp=0 00097 END IF 00098 IF(nr+nlc+ngl+2 > ndim) THEN 00099 icount=icount+1 00100 IF(icount <= 10) THEN 00101 WRITE(*,*) 'Mille warning: data can not be stored' 00102 IF(icount == 10) THEN 00103 WRITE(*,*) 'Mille warning: no further printout' 00104 END IF 00105 END IF 00106 inder(1)=inder(1)+1 ! count errors 00107 RETURN ! record dimension too small 00108 END IF 00109 nr=nr+1 00110 glder(nr)=rmeas ! measured value 00111 inder(nr)=0 00112 DO i=1,nlc ! local derivatives 00113 IF(derlc(i) /= 0.0) THEN 00114 nr=nr+1 00115 glder(nr)=derlc(i) ! derivative of local parameter 00116 inder(nr)=i ! index of local parameter 00117 END IF 00118 END DO 00119 00120 nr=nr+1 00121 glder(nr)=sigma ! error of measured value 00122 inder(nr)=0 00123 DO i=1,ngl ! global derivatives 00124 IF(dergl(i) /= 0.0.AND.label(i) > 0) THEN 00125 nr=nr+1 00126 glder(nr)=dergl(i) ! derivative of global parameter 00127 inder(nr)=label(i) ! index of global parameter 00128 END IF 00129 END DO 00130 RETURN 00131 00132 ENTRY MILLSP(nsp,dergl,label) 00133 ! add NSP special words (floating-point and integer) 00134 00135 ! 0.0 0 00136 ! -float(NSP) 0 ! indicates special data 00137 ! following NSP floating and NSP integer data 00138 00139 IF(nsp <= 0.OR.isp /= 0) RETURN 00140 isp=nr 00141 IF(nr == 0) THEN 00142 nr=1 00143 glder(1)=0.0 00144 inder(1)=0 ! error counter 00145 END IF 00146 IF(nr+nsp+2 > ndim) THEN 00147 inder(1)=inder(1)+1 ! count errors 00148 RETURN ! record dimension too small 00149 END IF 00150 nr=nr+1 ! zero pair 00151 glder(nr)=0.0 00152 inder(nr)=0 00153 nr=nr+1 ! nsp and zero 00154 glder(nr)=-FLOAT(nsp) 00155 inder(nr)=0 00156 DO i=1,nsp 00157 nr=nr+1 00158 glder(nr)=dergl(i) ! floating-point 00159 inder(nr)=label(i) ! integer 00160 END DO 00161 RETURN 00162 00163 ENTRY KILLE ! stop record 00164 nr=0 ! reset 00165 RETURN 00166 00167 ENTRY ENDLE ! end-of-record 00168 IF(nr > 1) THEN 00169 WRITE(lun) nr+nr,(glder(i),i=1,nr),(inder(i),i=1,nr) 00170 END IF 00171 nr=0 ! reset 00172 RETURN 00173 END SUBROUTINE MILLE
1.8.0
