LMU/musrsim
LMU/musrsim
5
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Created TimeStamp subroutine to remove code from main.

Browse Source
This commit is contained in:
salman 2013-03-07 15:07:12 +00:00
parent b62185a528
commit 74ba43035f
1 changed files with 79 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

220
trimsp/src/trimsp7l.F
View File

@ -183,6 +183,13 @@ c input files without the hassle of formatting.
c Included the source of ranlux for random numbers generation c Included the source of ranlux for random numbers generation
c into trimsp7l source. No need for cern libraries to be installed. c into trimsp7l source. No need for cern libraries to be installed.
c c
c Feb 2013: Zaher Salman PSI
c Started cleaning up the code.
c When possible remove loop numbres and use do-enddo instead.
c Using proper fortran line indentation (emacs style).
c Created TimeStamp subroutine to generate time stamp and removed
c original code from main (two places)
c
c------------------------------------------- c-------------------------------------------
c check OS c check OS
c c
@ -200,10 +207,7 @@ c
INTEGER I,J,IV INTEGER I,J,IV
INTEGER tryE,negE INTEGER tryE,negE
INTEGER COLCOUNT INTEGER COLCOUNT
INTEGER Date_time(8)
INTEGER days_total_stop !! TR
INTEGER depth_interval_flag INTEGER depth_interval_flag
INTEGER*4 days_start_total,days_stop_total
INTEGER*4 seconds_start_total,seconds_stop_total INTEGER*4 seconds_start_total,seconds_stop_total
INTEGER*4 NREC1,NREC2,NE1,K,NGIK,ICW INTEGER*4 NREC1,NREC2,NE1,K,NGIK,ICW
INTEGER*4 ISEED,ISEED2,ISEED3 INTEGER*4 ISEED,ISEED2,ISEED3
@ -389,7 +393,6 @@ C CHARACTER Variables
CHARACTER rgenam*12,rgeext*4,errnam*12,errext*4 CHARACTER rgenam*12,rgeext*4,errnam*12,errext*4
CHARACTER errcom*72 CHARACTER errcom*72
CHARACTER COLUMN(100)*246 CHARACTER COLUMN(100)*246
CHARACTER Real_Clock(3)*12
CHARACTER month_start*4,month_stop*4,day_start*2,day_stop*2 CHARACTER month_start*4,month_stop*4,day_start*2,day_stop*2
CHARACTER year_start*4,year_stop*4,hour_start*2,hour_stop*2 CHARACTER year_start*4,year_stop*4,hour_start*2,hour_stop*2
CHARACTER min_start*2,min_stop*2,sec_start*2,sec_stop*2 CHARACTER min_start*2,min_stop*2,sec_start*2,sec_stop*2
@ -508,25 +511,6 @@ C part. refl. coeff. from Thomas et al.
13591 CLOSE(UNIT=21) 13591 CLOSE(UNIT=21)
WRITE(*,*) Z1,M1,E0,Esig,ALPHA,ALPHASIG,EF,ESB,SHEATH,ERC
WRITE(*,*) NH,RI,RI2,RI3,X0,RD,CW,CA,KK0,KK0R,KDEE1,KDEE2 ,IPOT
& ,IPOTR,IRL
WRITE(*,*) DX(1),DX(2),DX(3),DX(4),DX(5),DX(6),DX(7),RHO(1),RHO(2)
& ,RHO(3),RHO(4),RHO(5),RHO(6),RHO(7), CK(1),CK(2),CK(3),CK(4)
& ,CK(5),CK(6),CK(7)
DO I=1,7
WRITE(*,'(1x,I2,A7)')i,'. Layer'
WRITE(*,*) ZT(I,1),ZT(I,2),ZT(I,3),ZT(I,4),ZT(I,5)
WRITE(*,*) MT(I,1),MT(I,2),MT(I,3),MT(I,4),MT(I,5)
WRITE(*,*) CO(I,1),CO(I,2),CO(I,3),CO(I,4),CO(I,5)
ENDDO
100 FORMAT(2F7.2,1F12.2,7F9.2)
101 FORMAT(I9,3F8.0,1F7.2,1F7.0,2F7.2,6I4,I3)
102 FORMAT(7F9.2,14F7.2)
103 FORMAT(5F9.4)
107 FORMAT(5F12.6)
C open statement for output files, removed from line 2449 ff to here C open statement for output files, removed from line 2449 ff to here
OPEN(UNIT=21,FILE=outnam,STATUS='new',ERR=6000) OPEN(UNIT=21,FILE=outnam,STATUS='new',ERR=6000)
GOTO 6001 GOTO 6001
@ -539,60 +523,13 @@ C open statement for output files, removed from line 2449 ff to here
WRITE(21,1000) WRITE(21,1000)
1000 FORMAT(1H1/,6X,'* PROGRAM TRVMC95 - V TrimSP7L 17.Oct.02 TP *') 1000 FORMAT(1H1/,6X,'* PROGRAM TRVMC95 - V TrimSP7L 17.Oct.02 TP *')
C 1st CALL DATE_AND_TIME CALL TimeStamp(day_start,month_start,year_start,hour_start
CALL DATE_AND_TIME(Real_Clock(1),Real_Clock(2),Real_Clock(3), & ,min_start,sec_start,seconds_start_total)
& Date_Time)
IF(Date_Time(2).EQ.1) THEN
month_start='Jan.'
days_start_total=Date_Time(3)
ELSEIF(Date_Time(2).EQ.2) THEN
month_start='Feb.'
days_start_total=31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.3) THEN
month_start='Mar.'
days_start_total=31+28+Date_Time(3)
ELSEIF(Date_Time(2).EQ.4) THEN
month_start='Apr.'
days_start_total=31+28+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.5) THEN
month_start='May '
days_start_total=31+28+31+30+Date_Time(3)
ELSEIF(Date_Time(2).EQ.6) THEN
month_start='Jun.'
days_start_total=31+28+31+30+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.7) THEN
month_start='Jul.'
days_start_total=31+28+31+30+31+30+Date_Time(3)
ELSEIF(Date_Time(2).EQ.8) THEN
month_start='Aug.'
days_start_total=31+28+31+30+31+30+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.9) THEN
month_start='Sep.'
days_start_total=31+28+31+30+31+30+31+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.10) THEN
month_start='Oct.'
days_start_total=31+28+31+30+31+30+31+31+30+Date_Time(3)
ELSEIF(Date_Time(2).EQ.11) THEN
month_start='Nov.'
days_start_total=31+28+31+30+31+30+31+31+30+31+Date_Time(3)
ELSE
month_start='Dec.'
days_start_total=31+28+31+30+31+30+31+31+30+31+30+Date_Time(3)
ENDIF
C in seconds from beginning of year
seconds_start_total=Date_Time(7)+(Date_Time(6)*60)+(Date_Time(5)
& *3600)+(days_start_total-1)*86400
READ(Real_Clock(1)(1:4),'(A4)')year_start
READ(Real_Clock(1)(7:8),'(A2)')day_start
READ(Real_Clock(2)(1:2),'(A2)')hour_start
READ(Real_Clock(2)(3:4),'(A2)')min_start
READ(Real_Clock(2)(5:6),'(A2)')sec_start
WRITE(21,*) WRITE(21,*)
WRITE(21,10050)day_start,month_start,year_start,hour_start WRITE(21,10050)day_start,month_start,year_start,hour_start
& ,min_start,sec_start & ,min_start,sec_start
WRITE(*,10050)day_start,month_start,year_start,hour_start
& ,min_start,sec_start
10050 FORMAT(1x,' TrimSp simulation started at: ',A2,'.',A4,1x,A4,1x,A2 10050 FORMAT(1x,' TrimSp simulation started at: ',A2,'.',A4,1x,A4,1x,A2
& ,':',A2,':',A2) & ,':',A2,':',A2)
@ -888,16 +825,13 @@ C GAUSSIAN ENERGY DISTRIBUTION
E(IV)=Epar E(IV)=Epar
ENDDO ENDDO
ENDIF ENDIF
C
C die nachfolgende Zeile wurden von Linie 633 hier hin verschoben
C
SFE = DMIN1(SB(1),SB(L)) SFE = DMIN1(SB(1),SB(L))
IF ( ALPHA.GE.0.D0 ) THEN IF ( ALPHA.GE.0.D0 ) THEN
IF(EQUAL(ALPHASIG,0.D0))THEN IF(EQUAL(ALPHASIG,0.D0))THEN
C C
C FIXED PROJECTILE ANGLE C FIXED PROJECTILE ANGLE
C C
C nachfolgende drei Zeilen waren vorher bei LINIE 633
ALFA = ALPHA /BW ALFA = ALPHA /BW
CALFA = DCOS(ALFA) CALFA = DCOS(ALFA)
SALFA = DSIN(ALFA) SALFA = DSIN(ALFA)
@ -2452,60 +2386,16 @@ C
ENDIF ENDIF
C 2nd CALL DATE_AND_TIME C 2nd CALL DATE_AND_TIME
CALL DATE_AND_TIME(Real_Clock(1),Real_Clock(2),Real_Clock(3),
& Date_Time)
IF(Date_Time(2).EQ.1) THEN
month_stop='Jan.'
days_total_stop=Date_Time(3)
ELSEIF(Date_Time(2).EQ.2) THEN
month_stop='Feb.'
days_stop_total=31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.3) THEN
month_stop='Mar.'
days_stop_total=31+28+Date_Time(3)
ELSEIF(Date_Time(2).EQ.4) THEN
month_stop='Apr.'
days_stop_total=31+28+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.5) THEN
month_stop='May '
days_stop_total=31+28+31+30+Date_Time(3)
ELSEIF(Date_Time(2).EQ.6) THEN
month_stop='Jun.'
days_stop_total=31+28+31+30+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.7) THEN
month_stop='Jul.'
days_stop_total=31+28+31+30+31+30+Date_Time(3)
ELSEIF(Date_Time(2).EQ.8) THEN
month_stop='Aug.'
days_stop_total=31+28+31+30+31+30+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.9) THEN
month_stop='Sep.'
days_stop_total=31+28+31+30+31+30+31+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.10) THEN
month_stop='Oct.'
days_stop_total=31+28+31+30+31+30+31+31+30+Date_Time(3)
ELSEIF(Date_Time(2).EQ.11) THEN
month_stop='Nov.'
days_stop_total=31+28+31+30+31+30+31+31+30+31+Date_Time(3)
ELSE
month_stop='Dec.'
days_stop_total=31+28+31+30+31+30+31+31+30+31+30+Date_Time(3)
ENDIF
READ(Real_Clock(1)(1:4),'(A4)')year_stop
READ(Real_Clock(1)(7:8),'(A2)')day_stop
READ(Real_Clock(2)(1:2),'(A2)')hour_stop
READ(Real_Clock(2)(3:4),'(A2)')min_stop
READ(Real_Clock(2)(5:6),'(A2)')sec_stop
C C
C how many seconds are needed for the simulation ?? C how many seconds are needed for the simulation ??
C C
seconds_stop_total=Date_Time(7)+(Date_Time(6)*60)+ (Date_Time(5) CALL TimeStamp(day_stop,month_stop,year_stop, hour_stop,min_stop
& *3600)+(days_stop_total-1)*86400 & ,sec_stop,seconds_stop_total)
WRITE(21,*) WRITE(21,*)
WRITE(21,10051)day_stop,month_stop,year_stop, hour_stop,min_stop WRITE(21,10051)day_stop,month_stop,year_stop, hour_stop,min_stop
& ,sec_stop & ,sec_stop
WRITE(*,10051)day_stop,month_stop,year_stop, hour_stop,min_stop
& ,sec_stop
10051 FORMAT(1x,' TrimSp simulation ended at: ',A2,'.',A4,1x,A4, 1x,A2 10051 FORMAT(1x,' TrimSp simulation ended at: ',A2,'.',A4,1x,A4, 1x,A2
& ,':',A2,':',A2) & ,':',A2,':',A2)
WRITE(21,*) WRITE(21,*)
@ -4510,18 +4400,69 @@ C
RETURN RETURN
END END
* SUBROUTINE TimeStamp(day,month,year,hour,min,sec,seconds_total)
* $Id: ranlux.F,v 1.2 1997/09/22 13:45:47 mclareni Exp $ IMPLICIT NONE
* INTEGER Date_Time(8)
* $Log: ranlux.F,v $ INTEGER*4 days_total
* Revision 1.2 1997/09/22 13:45:47 mclareni INTEGER*4 seconds_total
* Correct error in initializing RANLUX by using RLUXIN with the output of CHARACTER Real_Clock(3)*12
* RLUXUT from a previous run. CHARACTER month*4,day*2
* CHARACTER year*4,hour*2
* Revision 1.1.1.1 1996/04/01 15:02:55 mclareni CHARACTER min*2,sec*2
* Mathlib gen
* CALL DATE_AND_TIME(Real_Clock(1),Real_Clock(2),Real_Clock(3),
* & Date_Time)
IF(Date_Time(2).EQ.1) THEN
month='Jan.'
days_total=Date_Time(3)
ELSEIF(Date_Time(2).EQ.2) THEN
month='Feb.'
days_total=31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.3) THEN
month='Mar.'
days_total=31+28+Date_Time(3)
ELSEIF(Date_Time(2).EQ.4) THEN
month='Apr.'
days_total=31+28+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.5) THEN
month='May '
days_total=31+28+31+30+Date_Time(3)
ELSEIF(Date_Time(2).EQ.6) THEN
month='Jun.'
days_total=31+28+31+30+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.7) THEN
month='Jul.'
days_total=31+28+31+30+31+30+Date_Time(3)
ELSEIF(Date_Time(2).EQ.8) THEN
month='Aug.'
days_total=31+28+31+30+31+30+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.9) THEN
month='Sep.'
days_total=31+28+31+30+31+30+31+31+Date_Time(3)
ELSEIF(Date_Time(2).EQ.10) THEN
month='Oct.'
days_total=31+28+31+30+31+30+31+31+30+Date_Time(3)
ELSEIF(Date_Time(2).EQ.11) THEN
month='Nov.'
days_total=31+28+31+30+31+30+31+31+30+31+Date_Time(3)
ELSE
month='Dec.'
days_total=31+28+31+30+31+30+31+31+30+31+30+Date_Time(3)
ENDIF
C in seconds from beginning of year
seconds_total=Date_Time(7)+(Date_Time(6)*60)+(Date_Time(5) *3600)
& +(days_total-1)*86400
READ(Real_Clock(1)(1:4),'(A4)')year
READ(Real_Clock(1)(7:8),'(A2)')day
READ(Real_Clock(2)(1:2),'(A2)')hour
READ(Real_Clock(2)(3:4),'(A2)')min
READ(Real_Clock(2)(5:6),'(A2)')sec
RETURN
END
SUBROUTINE RANLUX(RVEC,LENV) SUBROUTINE RANLUX(RVEC,LENV)
C Subtract-and-borrow random number generator proposed by C Subtract-and-borrow random number generator proposed by
C Marsaglia and Zaman, implemented by F. James with the name C Marsaglia and Zaman, implemented by F. James with the name
@ -4592,15 +4533,12 @@ C Default Initialization by Multiplicative Congruential
NOTYET = .FALSE. NOTYET = .FALSE.
JSEED = JSDFLT JSEED = JSDFLT
INSEED = JSEED INSEED = JSEED
WRITE(6,'(A,I12)') ' RANLUX DEFAULT INITIALIZATION: ',JSEED
LUXLEV = LXDFLT LUXLEV = LXDFLT
NSKIP = NDSKIP(LUXLEV) NSKIP = NDSKIP(LUXLEV)
LP = NSKIP + 24 LP = NSKIP + 24
IN24 = 0 IN24 = 0
KOUNT = 0 KOUNT = 0
MKOUNT = 0 MKOUNT = 0
WRITE(6,'(A,I2,A,I4)') ' RANLUX DEFAULT LUXURY LEVEL = ',
+ LUXLEV,' p =',LP
TWOM24 = 1. TWOM24 = 1.
DO 25 I= 1, 24 DO 25 I= 1, 24
TWOM24 = TWOM24 * 0.5 TWOM24 = TWOM24 * 0.5