hypoxia/WRITE.FOR at main · dwormuth/hypoxia · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
C   ./ i 0
$STORAGE:2
      SUBROUTINE WRITE (IPRINT,LMNO)
      LOGICAL YES
      CHARACTER*4 ITAG(4),NAME,TITLE
      CHARACTER*6 UNITS
      CHARACTER*8 LABEL
      INTEGER CRTI,CRTO,FILE,FORM,TEMP,FPLOT, OUT(8)
      DIMENSION RLIST(75)
      REAL*8  LIST(75)
      COMMON ICOM1(170), CRTI,CRTO,FILE,FORM,TEMP,FPLOT,
     A   NAME(7),ISTUDY,IDATE(3),IFLAG(75),NVAR,NTABLE, PARAM(75),
     B   NVARY(15),VALUE(15,2),STEP(15),TITLE(18),NUMVAR,MAXVAR,
     C   NOUT(15),NUMOUT
      COMMON /PHRED/ IPRN
      COMMON /PHRED1/ LABEL(75)
      COMMON /PHRANK/ UNITS(75)
C
      DATA IPAGE,NLINES,NTEMP /0,99,0/
      DATA ITAG /'In  ','De  ','    ','**  '/
C
  137 FORMAT (3(I5,1X,A,F10.3))
  147 FORMAT (/' List data? (Y/N) '\)
  157 FORMAT (/' ',I2,1X,A,F7.2,1X,A,2X,I2,1X,A,F7.2,1X,A,2X,I2,1X,A,
     A F7.2,1X,A,\)
  217 FORMAT (' Save data to study file? (Y/N): '\)
  237 FORMAT (1H1,15X,'Hypoxia Analysis Study',25X,'Page',I3 //
     A   3X,7A4,3X,'Study No.',I8,3X,'Date',I3,2('/',I2)// 3X,18A4 /)
  247 FORMAT (1X,A2,F4.0,2X,A8,' (',I1,')',10F10.3)
  257 FORMAT (3X,A2,'crease ',A8,' (',I3,') from',F10.3,' to',F10.3)
  267 FORMAT (6X,'in steps of',F10.3)
  277 FORMAT (// 3X,'0 = Miss, 1 = Exp., 2 = Assumed, 3 = Calc.,',
     A   ' 4 = Variable' // 8X,'Parameter',15I10 //)
  287 FORMAT (' Data pass number',I3)
  307 FORMAT (8F10.4)
  317 FORMAT (16I4)
  327 FORMAT (1X,10A12)
  337 FORMAT (1X,120('-'))
  347 FORMAT (/(1X,10F12.3))
  357 FORMAT (3F10.2)
C
C     IPRINT = 1 - OUTPUT FORMATTED INFO
C
      GO TO (100,100,300,400,500), IPRINT
  100 CALL WRITE 2 (IPAGE)
C
C     INFO TO DATA BASE
C
      IF (IPRINT .EQ. 2)  GO TO 200
      WRITE (CRTO,147)
      CALL QQQANS (YES)
      IF (.NOT.(YES)) GO TO 151
      IDIVR = NVAR/3
      CALL CLEAR
      DO 7895 I = 1,IDIVR
      ITT  = I + IDIVR
      ITTT = I + IDIVR + IDIVR
 7895 WRITE (CRTO,157) I,LABEL(I),PARAM(I),UNITS(I),ITT,LABEL(ITT),
     A  PARAM(ITT),UNITS(ITT),ITTT,LABEL(ITTT),PARAM(ITTT),UNITS(ITTT)
      CALL QQQANS (YES)
  151 WRITE (CRTO,217)
      CALL QQQANS (YES)
      IF (YES)  CALL HFILE (LMNO)
      GO TO 9900
C
C     IPRINT = 2 - PUT VARYING INFO INTO TEMPORARY FILE, FORMAT AT 300
C
  200 NTEMP = NTEMP + 1
      WRITE (TEMP,317)  NTEMP,NVARY
      WRITE (TEMP,307)  PARAM
      GO TO 9900
C
C     IPRINT = 3 - OUTPUT TEMPORARY FILE DATA
C
  300 REWIND TEMP
      IPAGE = IPAGE + 1
      WRITE (FORM,237)  IPAGE,NAME,ISTUDY,IDATE,TITLE
      WRITE (IPRN,237)  IPAGE,NAME,ISTUDY,IDATE,TITLE
      DO 320  J = 1,NUMVAR
      ISUB = 1
      IF (VALUE(J,1) .GT. VALUE(J,2))  ISUB = 2
      NJ = NVARY (J)
      WRITE (FORM,257)  ITAG(ISUB), LABEL(NJ), NVARY(J),
     A   (VALUE(J,K), K=1,2)
      WRITE (IPRN,257)  ITAG(ISUB), LABEL(NJ), NVARY(J),
     A   (VALUE(J,K), K=1,2)
  320 CONTINUE
      S = ABS (STEP(1))
      IF (NUMVAR .EQ. 1)  WRITE (FORM,267)  S
      WRITE (FORM,277)  NTEMP, (M, M=1,NTEMP)
      WRITE (IPRN,277)  NTEMP, (M, M=1,NTEMP)
      NLINES = NUMVAR + 12
C
      DO 350  J = 1,NVAR
      IF ((J-1)/10*10 .EQ. (J-1))  WRITE (CRTO,287)  J
      REWIND TEMP
      IF (NLINES .LT. 55)  GO TO 330
      IPAGE = IPAGE + 1
C   ./ i 96
      CALL STAMP (IPRN)

      WRITE (FORM,237)  IPAGE,NAME,ISTUDY,IDATE,TITLE
      WRITE (IPRN,237)  IPAGE,NAME,ISTUDY,IDATE,TITLE
      WRITE (FORM,277)  NTEMP, (M, M=1,NTEMP)
      WRITE (IPRN,277)  NTEMP, (M, M=1,NTEMP)
      NLINES = 12
C
  330 DO 340  K2 = 1,NTEMP
      READ (TEMP,317)  ITEMP,IVARY
      READ (TEMP,307)  PARAM
      OUT (K2) = PARAM (J)
  340 CONTINUE
C
      ISUB = 3
      IF (IFLAG(J) .EQ. 4)  ISUB = 4
      WRITE (FORM,247)  ITAG(ISUB),J,LABEL(J),IFLAG(J),
     A   (OUT(I), I=1,NTEMP)
      WRITE (IPRN,247)  ITAG(ISUB),J,LABEL(J),IFLAG(J),
     A   (OUT(I), I=1,NTEMP)
      NLINES = NLINES + 1
  350 CONTINUE
      GO TO 9900
C
C     IPRINT = 4 - CREATE TABLE OF VARYING PARAMETERS
C
  400 NUM = (NUMVAR + NUMOUT - 1) / 10 + 1
      KS = NUMVAR + 1
      KE = NUMVAR + NUMOUT
      IF (NLINES .LE. 54)  GO TO 450
      NLINES = NUM + 8
      IPAGE = IPAGE + 1
      WRITE (FORM,237)  IPAGE,NAME,ISTUDY,IDATE,TITLE
      WRITE (IPRN,237)  IPAGE,NAME,ISTUDY,IDATE,TITLE
C
      DO 420  K2 = 1,NUMVAR
      KSUB = NVARY (K2)
      LIST (K2) = LABEL (KSUB)
  420 CONTINUE
      K = 0
      DO 430  K2 = KS,KE
      K = K + 1
      KSUB = NOUT (K)
      LIST (K2) = LABEL (KSUB)
  430 CONTINUE
C
      WRITE (FORM,327)  (LIST(K2), K2=1,KE)
      WRITE (IPRN,327)  (LIST(K2), K2=1,KE)
      WRITE (FORM,337)
      WRITE (IPRN,337)
C
  450 DO 460  K2 = 1,NUMVAR
      KSUB = NVARY (K2)
      RLIST (K2) = PARAM (KSUB)
  460 CONTINUE
      K = 0
      DO 470  K2 = KS,KE
      K = K + 1
      KSUB = NOUT (K)
      RLIST (K2) = PARAM (KSUB)
  470 CONTINUE
C
      WRITE (FORM,347)  (RLIST(K2), K2=1,KE)
      WRITE (IPRN,347)  (RLIST(K2), K2=1,KE)
      NLINES = NLINES + NUM + 1
      GO TO 9900
C
C     IPRINT = 5 - PLOT DATA INTO PLOT FILE  (ONLY IF ALL DATA POS.)
C
  500 DO 510  K2 = 1,3
      KSUB = NVARY(K2)
      IF (PARAM(KSUB) .LT. 0.0)  GO TO 9900
      RLIST (K2) = PARAM (KSUB)
  510 CONTINUE
C
      WRITE (FPLOT,357)  (RLIST(K2), K2=1,3)
C
 9900 RETURN
      END