-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathgfdeco.f
2364 lines (2156 loc) · 108 KB
/
gfdeco.f
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
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
PROGRAM GFDECO
C===============================================================================
C Gradient Factor Decompression Program in FORTRAN
C
C Author: Erik C. Baker
C
C "DISTRIBUTE FREELY - CREDIT THE AUTHOR"
C
C Notes:
C 1. This program uses the sixteen (16) half-time compartments of the
C Buhlmann ZH-L16 model. The optional Compartment 1b is used here with
C half-times of 1.88 minutes for helium and 5.0 minutes for nitrogen.
C Conservatism and deep stops are introduced in the decompression
C profiles by use of gradient factors.
C
C 2. This program uses various DEC, IBM, and Microsoft extensions which
C may not be supported by all FORTRAN compilers. Comments are made with
C a capital "C" in the first column or an exclamation point "!" placed
C in a line after code. An asterisk "*" in column 6 is a continuation
C of the previous line. All code, except for line numbers, starts in
C column 7.
C
C 3. Comments and suggestions for improvements are welcome. Please
C respond by e-mail to: [email protected]
C
C==============================================================================
IMPLICIT NONE
C===============================================================================
C LOCAL VARIABLES - MAIN PROGRAM
C===============================================================================
CHARACTER M*1, OS_Command*3, Word*7, Units*3
CHARACTER Line1*70
CHARACTER Units_Word1*4, Units_Word2*7, Units_Word3*6
CHARACTER Units_Word4*5, Altitude_Dive_Algorithm*3
INTEGER I, J !loop counters
INTEGER*2 Month, Day, Year, Clock_Hour, Minute
INTEGER Number_of_Mixes, Number_of_Changes, Profile_Code
INTEGER Repetitive_Dive_Flag
LOGICAL Altitude_Dive_Algorithm_Off
REAL Deco_Ceiling_Depth, Deco_Stop_Depth, Step_Size
REAL Sum_of_Fractions, Sum_Check
REAL Depth, Ending_Depth, Starting_Depth
REAL Rate, Rounding_Operation1, Run_Time_End_of_Segment
REAL Last_Run_Time, Stop_Time, Depth_Start_of_Deco_Zone
REAL Rounding_Operation2, Deepest_Possible_Stop_Depth
REAL Next_Stop
REAL Surface_Interval_Time
REAL RMV_During_Dive, RMV_During_Deco
REAL Gradient_Factor_Lo, Gradient_Factor_Hi, Factor_Slope
REAL Gradient_Factor_Current_Stop, Gradient_Factor_Next_Stop
C===============================================================================
C LOCAL ARRAYS - MAIN PROGRAM
C===============================================================================
INTEGER Mix_Change(10)
REAL Depth_Change (10)
REAL Rate_Change(10), Step_Size_Change(10)
REAL Helium_Half_Time(16), Nitrogen_Half_Time(16)
C===============================================================================
C GLOBAL CONSTANTS IN NAMED COMMON BLOCKS
C===============================================================================
REAL Water_Vapor_Pressure
COMMON /Block_8/ Water_Vapor_Pressure
REAL Minimum_Deco_Stop_Time
COMMON /Block_21/ Minimum_Deco_Stop_Time
C===============================================================================
C GLOBAL VARIABLES IN NAMED COMMON BLOCKS
C===============================================================================
INTEGER Segment_Number
REAL Run_Time, Segment_Time
COMMON /Block_2/ Run_Time, Segment_Number, Segment_Time
REAL Ending_Ambient_Pressure
COMMON /Block_4/ Ending_Ambient_Pressure
INTEGER Mix_Number
COMMON /Block_9/ Mix_Number
REAL Barometric_Pressure
COMMON /Block_18/ Barometric_Pressure
LOGICAL Units_Equal_Fsw, Units_Equal_Msw
COMMON /Block_15/ Units_Equal_Fsw, Units_Equal_Msw
REAL Units_Factor
COMMON /Block_16/ Units_Factor
REAL Running_CNS, Running_OTU
COMMON /Block_32/ Running_CNS, Running_OTU
REAL Altitude_of_Dive
COMMON /Block_33/ Altitude_of_Dive
REAL Gradient_Factor
COMMON /Block_37/ Gradient_Factor
C===============================================================================
C GLOBAL ARRAYS IN NAMED COMMON BLOCKS
C===============================================================================
REAL Helium_Time_Constant(16)
COMMON /Block_1A/ Helium_Time_Constant
REAL Nitrogen_Time_Constant(16)
COMMON /Block_1B/ Nitrogen_Time_Constant
REAL Helium_Pressure(16), Nitrogen_Pressure(16)
COMMON /Block_3/ Helium_Pressure, Nitrogen_Pressure
REAL Fraction_Helium(10), Fraction_Nitrogen(10)
COMMON /Block_5/ Fraction_Helium, Fraction_Nitrogen
REAL Fraction_Oxygen(10)
COMMON /Block_30/ Fraction_Oxygen
REAL Running_Gas_Volume(10)
COMMON /Block_31/ Running_Gas_Volume
REAL AHE(16), BHE(16), AN2(16), BN2(16)
COMMON /Block_34/ AHE, BHE, AN2, BN2
REAL Coefficient_AHE(16), Coefficient_BHE(16)
REAL Coefficient_AN2(16), Coefficient_BN2(16)
COMMON /Block_35/ Coefficient_AHE, Coefficient_BHE,
* Coefficient_AN2, Coefficient_BN2
C===============================================================================
C NAMELIST FOR PROGRAM SETTINGS (READ IN FROM ASCII TEXT FILE)
C===============================================================================
NAMELIST /Program_Settings/ Units, Altitude_Dive_Algorithm,
* Minimum_Deco_Stop_Time, Gradient_Factor_Lo,
* Gradient_Factor_Hi, RMV_During_Dive,
* RMV_During_Deco
C===============================================================================
C ASSIGN HALF-TIME VALUES TO BUHLMANN COMPARTMENT ARRAYS
C===============================================================================
DATA Helium_Half_Time(1)/1.88/,Helium_Half_Time(2)/3.02/,
* Helium_Half_Time(3)/4.72/,Helium_Half_Time(4)/6.99/,
* Helium_Half_Time(5)/10.21/,Helium_Half_Time(6)/14.48/,
* Helium_Half_Time(7)/20.53/,Helium_Half_Time(8)/29.11/,
* Helium_Half_Time(9)/41.20/,Helium_Half_Time(10)/55.19/,
* Helium_Half_Time(11)/70.69/,Helium_Half_Time(12)/90.34/,
* Helium_Half_Time(13)/115.29/,Helium_Half_Time(14)/147.42/,
* Helium_Half_Time(15)/188.24/,Helium_Half_Time(16)/240.03/
DATA Nitrogen_Half_Time(1)/5.0/,Nitrogen_Half_Time(2)/8.0/,
* Nitrogen_Half_Time(3)/12.5/,Nitrogen_Half_Time(4)/18.5/,
* Nitrogen_Half_Time(5)/27.0/,Nitrogen_Half_Time(6)/38.3/,
* Nitrogen_Half_Time(7)/54.3/,Nitrogen_Half_Time(8)/77.0/,
* Nitrogen_Half_Time(9)/109.0/,Nitrogen_Half_Time(10)/146.0/,
* Nitrogen_Half_Time(11)/187.0/,Nitrogen_Half_Time(12)/239.0/,
* Nitrogen_Half_Time(13)/305.0/,Nitrogen_Half_Time(14)/390.0/,
* Nitrogen_Half_Time(15)/498.0/,Nitrogen_Half_Time(16)/635.0/
C===============================================================================
C OPEN FILES FOR PROGRAM INPUT/OUTPUT
C===============================================================================
OPEN (UNIT = 7, FILE = 'GFDECO.IN', STATUS = 'UNKNOWN',
* ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED')
OPEN (UNIT = 8, FILE = 'GFDECO.OUT', STATUS = 'UNKNOWN',
* ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED')
OPEN (UNIT = 10, FILE = 'GFDECO.SET', STATUS = 'UNKNOWN',
* ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED')
OPEN (UNIT = 13, FILE = 'DIVEDATA.OUT', STATUS = 'UNKNOWN',
* ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED')
C===============================================================================
C BEGIN PROGRAM EXECUTION WITH OUTPUT MESSAGE TO SCREEN
C===============================================================================
PRINT *,' '
PRINT *,'PROGRAM GFDECO'
PRINT *,' ' !asterisk indicates print to screen
C===============================================================================
C READ IN PROGRAM SETTINGS AND CHECK FOR ERRORS
C IF THERE ARE ERRORS, WRITE AN ERROR MESSAGE AND TERMINATE PROGRAM
C===============================================================================
READ (10,Program_Settings)
IF ((Units .EQ. 'fsw').OR.(Units .EQ. 'FSW')) THEN
Units_Equal_Fsw = (.TRUE.)
Units_Equal_Msw = (.FALSE.)
ELSE IF ((Units .EQ. 'msw').OR.(Units .EQ. 'MSW')) THEN
Units_Equal_Fsw = (.FALSE.)
Units_Equal_Msw = (.TRUE.)
ELSE
WRITE (*,901)
WRITE (*,900)
STOP 'PROGRAM TERMINATED'
END IF
IF ((Altitude_Dive_Algorithm .EQ. 'ON') .OR.
* (Altitude_Dive_Algorithm .EQ. 'on')) THEN
Altitude_Dive_Algorithm_Off = (.FALSE.)
ELSE IF ((Altitude_Dive_Algorithm .EQ. 'OFF') .OR.
* (Altitude_Dive_Algorithm .EQ. 'off')) THEN
Altitude_Dive_Algorithm_Off = (.TRUE.)
ELSE
WRITE (*,902)
WRITE (*,900)
STOP 'PROGRAM TERMINATED'
END IF
C===============================================================================
C INITIALIZE CONSTANTS/VARIABLES BASED ON SELECTION OF UNITS - FSW OR MSW
C fsw = feet of seawater, a unit of pressure
C msw = meters of seawater, a unit of pressure
C===============================================================================
IF (Units_Equal_Fsw) THEN
WRITE (*,800)
Units_Word1 = 'fswg'
Units_Word2 = 'fsw/min'
Units_Word3 = ' (scf)'
Units_Word4 = ' acf'
Units_Factor = 33.0
Water_Vapor_Pressure = 1.848 !based on respiratory quotient of 0.9
!(U.S. Navy value)
DO I = 1,16
Coefficient_AHE(I) = AHE(I) * 3.25684678
Coefficient_BHE(I) = BHE(I)
Coefficient_AN2(I) = AN2(I) * 3.25684678
Coefficient_BN2(I) = BN2(I)
END DO
END IF
IF (Units_Equal_Msw) THEN
WRITE (*,801)
Units_Word1 = 'mswg'
Units_Word2 = 'msw/min'
Units_Word3 = 'liters'
Units_Word4 = 'liter'
Units_Factor = 10.1325
Water_Vapor_Pressure = 0.567 !based on respiratory quotient of 0.9
!(U.S. Navy value)
DO I = 1,16
Coefficient_AHE(I) = AHE(I)
Coefficient_BHE(I) = BHE(I)
Coefficient_AN2(I) = AN2(I)
Coefficient_BN2(I) = BN2(I)
END DO
END IF
C===============================================================================
C INITIALIZE CONSTANTS/VARIABLES
C===============================================================================
Run_Time = 0.0
Segment_Number = 0
Gradient_Factor = Gradient_Factor_Lo
DO I = 1,16
Helium_Time_Constant(I) = ALOG(2.0)/Helium_Half_Time(I)
Nitrogen_Time_Constant(I) = ALOG(2.0)/Nitrogen_Half_Time(I)
END DO
C===============================================================================
C INITIALIZE VARIABLES FOR SEA LEVEL OR ALTITUDE DIVE
C===============================================================================
IF (Altitude_Dive_Algorithm_Off) THEN
Altitude_of_Dive = 0.0
CALL CALC_BAROMETRIC_PRESSURE (Altitude_of_Dive) !subroutine
WRITE (*,802) Altitude_of_Dive, Barometric_Pressure
DO I = 1,16
Helium_Pressure(I) = 0.0
Nitrogen_Pressure(I) = (Barometric_Pressure -
* Water_Vapor_Pressure)*0.79
END DO
ELSE
CALL ALTITUDE_DIVE_SUBPROGRAM !subroutine
END IF
C===============================================================================
C START OF REPETITIVE DIVE LOOP
C This is the largest loop in the main program and operates between Lines
C 30 and 330. If there is one or more repetitive dives, the program will
C return to this point to process each repetitive dive.
C===============================================================================
30 DO 330, WHILE (.TRUE.) !loop will run continuously until
!there is an exit statement
C===============================================================================
C INPUT DIVE DESCRIPTION AND GAS MIX DATA FROM ASCII TEXT INPUT FILE
C BEGIN WRITING HEADINGS/OUTPUT TO ASCII TEXT OUTPUT FILES
C===============================================================================
READ (7,805) Line1
CALL CLOCK (Year, Month, Day, Clock_Hour, Minute, M) !subroutine
WRITE (8,810)
WRITE (8,811)
WRITE (8,812)
WRITE (8,813)
WRITE (8,813)
WRITE (8,814) Month, Day, Year, Clock_Hour, Minute, M
WRITE (8,813)
WRITE (8,815) Line1
WRITE (8,813)
WRITE (13,810)
WRITE (13,811)
WRITE (13,812)
WRITE (13,813)
WRITE (13,813)
WRITE (13,814) Month, Day, Year, Clock_Hour, Minute, M
WRITE (13,813)
WRITE (13,815) Line1
IF (Units_Equal_Fsw) THEN
WRITE (13,813)
WRITE (13,610) Altitude_of_Dive, Barometric_Pressure,
* (Barometric_Pressure/33.0)*1013.25
WRITE (13,813)
END IF
IF (Units_Equal_Msw) THEN
WRITE (13,813)
WRITE (13,611) Altitude_of_Dive, Barometric_Pressure,
* (Barometric_Pressure/10.0)*1000.0
WRITE (13,813)
END IF
READ (7,*) Number_of_Mixes !check for errors in gasmixes
DO I = 1, Number_of_Mixes
READ (7,*) Fraction_Oxygen(I), Fraction_Helium(I),
* Fraction_Nitrogen(I)
Sum_of_Fractions = Fraction_Oxygen(I) + Fraction_Helium(I) +
* Fraction_Nitrogen(I)
Sum_Check = Sum_of_Fractions
IF (Sum_Check .NE. 1.0) THEN
WRITE (*,906)
WRITE (*,900)
STOP 'PROGRAM TERMINATED'
END IF
END DO
WRITE (8,820)
DO J = 1, Number_of_Mixes
WRITE (8,821) J, Fraction_Oxygen(J), Fraction_Helium(J),
* Fraction_Nitrogen(J)
END DO
DO I = 1, Number_of_Mixes
Running_Gas_Volume(I) = 0.0
END DO
WRITE (8,813)
WRITE (8,813)
WRITE (8,830)
WRITE (8,813)
WRITE (8,831)
WRITE (8,832)
WRITE (8,833) Units_Word1, Units_Word1, Units_Word2,
* Units_Word1
WRITE (8,834)
WRITE (13,813)
WRITE (13,600)
WRITE (13,813)
WRITE (13,601)
WRITE (13,602) Units_Word4
WRITE (13,603) Units_Word3, Units_Word1, Units_Word1,
* Units_Word1
WRITE (13,604)
C===============================================================================
C DIVE PROFILE LOOP - INPUT DIVE PROFILE DATA FROM ASCII TEXT INPUT FILE
C AND PROCESS DIVE AS A SERIES OF ASCENT/DESCENT AND CONSTANT DEPTH
C SEGMENTS. THIS ALLOWS FOR MULTI-LEVEL (DESCENDING) DIVE PROFILES. NOTE
C THAT THE DECO CEILING IS NOT CHECKED DURING THE DIVE PROFILE SO USERS
C MUST NOT ENTER AN ASCENT SEGMENT THAT WOULD VIOLATE A DECO CEILING.
C THE GAS LOADINGS FOR EACH SEGMENT OF THE DIVE PROFILE ARE UPDATED.
C Profile codes: 1 = Ascent/Descent, 2 = Constant Depth, 99 = Decompress
C===============================================================================
DO WHILE (.TRUE.) !loop will run continuously until
!there is an exit statement
READ (7,*) Profile_Code
IF (Profile_Code .EQ. 1) THEN
READ (7,*) Starting_Depth, Ending_Depth, Rate, Mix_Number
CALL GAS_LOADINGS_ASCENT_DESCENT (Starting_Depth, !subroutine
* Ending_Depth, Rate)
IF (Ending_Depth .GT. Starting_Depth) THEN
Word = 'Descent'
ELSE IF (Starting_Depth .GT. Ending_Depth) THEN
Word = 'Ascent '
ELSE
Word = 'ERROR'
END IF
WRITE (8,840) Segment_Number, Segment_Time, Run_Time,
* Mix_Number, Word, Starting_Depth,
* Ending_Depth, Rate
CALL DIVEDATA_ASCENT_DESCENT (Starting_Depth, !subroutine
* Ending_Depth, Rate, RMV_During_Dive)
ELSE IF (Profile_Code .EQ. 2) THEN
READ (7,*) Depth, Run_Time_End_of_Segment, Mix_Number
CALL GAS_LOADINGS_CONSTANT_DEPTH (Depth, !subroutine
* Run_Time_End_of_Segment)
WRITE (8,845) Segment_Number, Segment_Time, Run_Time,
* Mix_Number, Depth
CALL DIVEDATA_CONSTANT_DEPTH (Depth, RMV_During_Dive) !subroutine
ELSE IF (Profile_Code .EQ. 99) THEN
EXIT
ELSE
WRITE (*,907)
WRITE (*,900)
STOP 'PROGRAM TERMINATED'
END IF
END DO
C===============================================================================
C INPUT PARAMETERS TO BE USED FOR STAGED DECOMPRESSION AND SAVE IN ARRAYS.
C ASSIGN INITAL PARAMETERS TO BE USED AT START OF ASCENT
C The user has the ability to change mix, ascent rate, and step size in any
C combination at any depth during the ascent.
C===============================================================================
READ (7,*) Number_of_Changes
DO I = 1, Number_of_Changes
READ (7,*) Depth_Change(I), Mix_Change(I), Rate_Change(I),
* Step_Size_Change(I)
END DO
Starting_Depth = Depth_Change(1)
Mix_Number = Mix_Change(1)
Rate = Rate_Change(1)
Step_Size = Step_Size_Change(1)
Last_Run_Time = 0.0
C===============================================================================
C CALCULATE THE DEPTH WHERE THE DECOMPRESSION ZONE BEGINS FOR THIS PROFILE
C BASED ON THE INITIAL ASCENT PARAMETERS AND WRITE THE DEEPEST POSSIBLE
C DECOMPRESSION STOP DEPTH TO THE OUTPUT FILE
C Knowing where the decompression zone starts is very important. Below
C that depth there is no possibility for bubble formation because there
C will be no supersaturation gradients. Deco stops should never start
C below the deco zone. The deepest possible stop deco stop depth is
C defined as the next "standard" stop depth above the point where the
C leading compartment enters the deco zone. Thus, the program will not
C base this calculation on step sizes larger than 10 fsw or 3 msw. The
C deepest possible stop depth is not used in the program, per se, rather
C it is information to tell the diver where to start putting on the brakes
C during ascent. This should be prominently displayed by any deco program.
C===============================================================================
CALL CALC_START_OF_DECO_ZONE (Starting_Depth, Rate, !subroutine
* Depth_Start_of_Deco_Zone)
IF (Units_Equal_Fsw) THEN
IF (Step_Size .LT. 10.0) THEN
Rounding_Operation1 =
* (Depth_Start_of_Deco_Zone/Step_Size) - 0.5
Deepest_Possible_Stop_Depth = ANINT(Rounding_Operation1)
* * Step_Size
ELSE
Rounding_Operation1 = (Depth_Start_of_Deco_Zone/10.0)
* - 0.5
Deepest_Possible_Stop_Depth = ANINT(Rounding_Operation1)
* * 10.0
END IF
END IF
IF (Units_Equal_Msw) THEN
IF (Step_Size .LT. 3.0) THEN
Rounding_Operation1 =
* (Depth_Start_of_Deco_Zone/Step_Size) - 0.5
Deepest_Possible_Stop_Depth = ANINT(Rounding_Operation1)
* * Step_Size
ELSE
Rounding_Operation1 = (Depth_Start_of_Deco_Zone/3.0)
* - 0.5
Deepest_Possible_Stop_Depth = ANINT(Rounding_Operation1)
* * 3.0
END IF
END IF
WRITE (8,813)
WRITE (8,813)
WRITE (8,850)
WRITE (8,813)
WRITE (8,857) Depth_Start_of_Deco_Zone, Units_Word1
WRITE (8,858) Deepest_Possible_Stop_Depth, Units_Word1
WRITE (8,813)
WRITE (8,851)
WRITE (8,852)
WRITE (8,853) Units_Word1, Units_Word2, Units_Word1
WRITE (8,854)
C===============================================================================
C CALCULATE CURRENT DECO CEILING AND SET FIRST DECO STOP. CHECK TO MAKE
C SURE THAT SELECTED STEP SIZE WILL NOT ROUND UP FIRST STOP TO A DEPTH THAT
C IS BELOW THE DECO ZONE.
C===============================================================================
CALL CALC_DECO_CEILING (Deco_Ceiling_Depth) !subroutine
IF (Deco_Ceiling_Depth .LE. 0.0) THEN
Deco_Stop_Depth = 0.0
ELSE
Rounding_Operation2 = (Deco_Ceiling_Depth/Step_Size) + 0.5
Deco_Stop_Depth = ANINT(Rounding_Operation2) * Step_Size
END IF
IF (Deco_Stop_Depth .GT. Depth_Start_of_Deco_Zone) THEN
WRITE (*,905)
WRITE (*,900)
STOP 'PROGRAM TERMINATED'
END IF
C===============================================================================
C PERFORM A SEPARATE "PROJECTED ASCENT" OUTSIDE OF THE MAIN PROGRAM TO MAKE
C SURE THAT AN INCREASE IN GAS LOADINGS DURING ASCENT TO THE FIRST STOP WILL
C NOT CAUSE A VIOLATION OF THE DECO CEILING. IF SO, ADJUST THE FIRST STOP
C DEEPER BASED ON STEP SIZE UNTIL A SAFE ASCENT CAN BE MADE.
C Note: this situation is a possibility when ascending from extremely deep
C dives or due to an unusual gas mix selection.
C CHECK AGAIN TO MAKE SURE THAT ADJUSTED FIRST STOP WILL NOT BE BELOW THE
C DECO ZONE.
C===============================================================================
CALL PROJECTED_ASCENT (Starting_Depth, Rate, !subroutine
* Deco_Stop_Depth, Step_Size)
IF (Deco_Stop_Depth .GT. Depth_Start_of_Deco_Zone) THEN
WRITE (*,905)
WRITE (*,900)
STOP 'PROGRAM TERMINATED'
END IF
C===============================================================================
C SET GRADIENT FACTOR SLOPE
C===============================================================================
IF (Deco_Stop_Depth .GT. 0.0) THEN
Factor_Slope = (Gradient_Factor_Hi - Gradient_Factor_Lo)/
* (0.0 - Deco_Stop_Depth)
END IF
C===============================================================================
C DECO STOP LOOP BLOCK FOR DECOMPRESSION SCHEDULE
C===============================================================================
DO WHILE (.TRUE.) !loop will run continuously until
!there is an exit statement
CALL GAS_LOADINGS_ASCENT_DESCENT (Starting_Depth, !subroutine
* Deco_Stop_Depth, Rate)
CALL DIVEDATA_ASCENT_DESCENT (Starting_Depth, !subroutine
* Deco_Stop_Depth, Rate, RMV_During_Deco)
WRITE (8,860) Segment_Number, Segment_Time, Run_Time,
* Mix_Number, Deco_Stop_Depth, Rate
IF (Deco_Stop_Depth .EQ. 0.0) THEN
WRITE (8,861) Gradient_Factor
END IF
IF (Deco_Stop_Depth .LE. 0.0) EXIT !exit at Line 80
IF (Number_of_Changes .GT. 1) THEN
DO I = 2, Number_of_Changes
IF (Depth_Change(I) .GE. Deco_Stop_Depth) THEN
Mix_Number = Mix_Change(I)
Rate = Rate_Change(I)
Step_Size = Step_Size_Change(I)
END IF
END DO
END IF
Gradient_Factor_Current_Stop = Gradient_Factor
Next_Stop = Deco_Stop_Depth - Step_Size
Gradient_Factor_Next_Stop = Next_Stop * Factor_Slope +
* Gradient_Factor_Hi
Gradient_Factor = Gradient_Factor_Next_Stop
CALL DECOMPRESSION_STOP (Deco_Stop_Depth, Step_Size) !subroutine
CALL DIVEDATA_CONSTANT_DEPTH (Deco_Stop_Depth, !subroutine
* RMV_During_Deco)
C===============================================================================
C This next bit justs rounds up the stop time at the first stop to be in
C whole increments of the minimum stop time (to make for a nice deco table).
C===============================================================================
IF (Last_Run_Time .EQ. 0.0) THEN
Stop_Time =
* ANINT((Segment_Time/Minimum_Deco_Stop_Time) + 0.5) *
* Minimum_Deco_Stop_Time
ELSE
Stop_Time = Run_Time - Last_Run_Time
END IF
C===============================================================================
C IF MINIMUM STOP TIME PARAMETER IS A WHOLE NUMBER (i.e. 1 minute) THEN
C WRITE DECO SCHEDULE USING INTEGER NUMBERS (looks nicer). OTHERWISE, USE
C DECIMAL NUMBERS.
C Note: per the request of a noted exploration diver(!), program now allows
C a minimum stop time of less than one minute so that total ascent time can
C be minimized on very long dives. In fact, with step size set at 1 fsw or
C 0.2 msw and minimum stop time set at 0.1 minute (6 seconds), a near
C continuous decompression schedule can be computed.
C===============================================================================
IF (AINT(Minimum_Deco_Stop_Time) .EQ.
* Minimum_Deco_Stop_Time) THEN
WRITE (8,862) Segment_Number, Segment_Time, Run_Time,
* Mix_Number, Gradient_Factor_Current_Stop,
* INT(Deco_Stop_Depth),
* INT(Stop_Time), INT(Run_Time)
ELSE
WRITE (8,863) Segment_Number, Segment_Time, Run_Time,
* Mix_Number, Gradient_Factor_Current_Stop,
* Deco_Stop_Depth, Stop_Time,
* Run_Time
END IF
Starting_Depth = Deco_Stop_Depth
Deco_Stop_Depth = Next_Stop
Last_Run_Time = Run_Time
80 END DO !end of deco stop loop block
C===============================================================================
C Write to DIVEDATA output file
C===============================================================================
WRITE (13,701)
WRITE (13,702) Running_CNS, Running_OTU
WRITE (13,703)
WRITE (13,813)
WRITE (13,813)
WRITE (13,704)
WRITE (13,705) Units_Word3
DO I = 1, Number_of_Mixes
WRITE (13,706) I, Running_Gas_Volume(I),
* Running_Gas_Volume(I)*1.5
END DO
C===============================================================================
C PROCESSING OF DIVE COMPLETE. READ INPUT FILE TO DETERMINE IF THERE IS A
C REPETITIVE DIVE. IF NONE, THEN EXIT REPETITIVE LOOP.
C===============================================================================
READ (7,*) Repetitive_Dive_Flag
IF (Repetitive_Dive_Flag .EQ. 0) THEN
EXIT !exit repetitive dive loop
!at Line 330
C===============================================================================
C IF THERE IS A REPETITIVE DIVE, COMPUTE GAS LOADINGS (OFF-GASSING) DURING
C SURFACE INTERVAL TIME. RE-INITIALIZE SELECTED VARIABLES AND RETURN TO
C START OF REPETITIVE LOOP AT LINE 30.
C===============================================================================
ELSE IF (Repetitive_Dive_Flag .EQ. 1) THEN
READ (7,*) Surface_Interval_Time
CALL GAS_LOADINGS_SURFACE_INTERVAL (Surface_Interval_Time) !subroutine
Run_Time = 0.0
Segment_Number = 0
Gradient_Factor = Gradient_Factor_Lo
Running_CNS = 0.0
Running_OTU = 0.0
WRITE (8,880)
WRITE (8,890)
WRITE (8,813)
WRITE (13,880)
WRITE (13,890)
WRITE (13,813)
CYCLE !Return to start of repetitive loop to process another dive
C===============================================================================
C WRITE ERROR MESSAGE AND TERMINATE PROGRAM IF THERE IS AN ERROR IN THE
C INPUT FILE FOR THE REPETITIVE DIVE FLAG
C===============================================================================
ELSE
WRITE (*,908)
WRITE (*,900)
STOP 'PROGRAM TERMINATED'
END IF
330 CONTINUE !End of repetitive loop
C===============================================================================
C FINAL WRITES TO OUTPUT AND CLOSE PROGRAM FILES
C===============================================================================
WRITE (*,813)
WRITE (*,871)
WRITE (*,872)
WRITE (*,813)
WRITE (8,880)
WRITE (13,880)
CLOSE (UNIT = 7, STATUS = 'KEEP')
CLOSE (UNIT = 8, STATUS = 'KEEP')
CLOSE (UNIT = 10, STATUS = 'KEEP')
CLOSE (UNIT = 13, STATUS = 'KEEP')
C===============================================================================
C FORMAT STATEMENTS - PROGRAM INPUT/OUTPUT
C===============================================================================
800 FORMAT ('0UNITS = FEET OF SEAWATER (FSW)')
801 FORMAT ('0UNITS = METERS OF SEAWATER (MSW)')
802 FORMAT ('0ALTITUDE = ',1X,F7.1,4X,'BAROMETRIC PRESSURE = ',
* F6.3)
805 FORMAT (A70)
810 FORMAT ('7E7&a10L7&l80F7&l8D7(s0p16.67h8.5')
811 FORMAT (26X,'DECOMPRESSION CALCULATION PROGRAM')
812 FORMAT (24X,'Developed in FORTRAN by Erik C. Baker')
814 FORMAT ('Program Run:',4X,I2.2,'-',I2.2,'-',I4,1X,'at',1X,I2.2,
* ':',I2.2,1X,A1,'m',23X,'Model: ZH-L16B/GF')
815 FORMAT ('Description:',4X,A70)
813 FORMAT (' ')
820 FORMAT ('Gasmix Summary:',24X,'FO2',4X,'FHe',4X,'FN2')
821 FORMAT (26X,'Gasmix #',I2,2X,F5.3,2X,F5.3,2X,F5.3)
830 FORMAT (36X,'DIVE PROFILE')
831 FORMAT ('Seg-',2X,'Segm.',2X,'Run',3X,'|',1X,'Gasmix',1X,'|',1X,
* 'Ascent',4X,'From',5X,'To',6X,'Rate',4X,'|',1X,'Constant')
832 FORMAT ('ment',2X,'Time',3X,'Time',2X,'|',2X,'Used',2X,'|',3X,
* 'or',5X,'Depth',3X,'Depth',4X,'+Dn/-Up',2X,'|',2X,'Depth')
833 FORMAT (2X,'#',3X,'(min)',2X,'(min)',1X,'|',4X,'#',3X,'|',1X,
* 'Descent',2X,'(',A4,')',2X,'(',A4,')',2X,'(',A7,')',1X,
* '|',2X,'(',A4,')')
834 FORMAT ('-----',1X,'-----',2X,'-----',1X,'|',1X,'------',1X,'|',
* 1X,'-------',2X,'------',2X,'------',2X,'---------',1X,
* '|',1X,'--------')
840 FORMAT (I3,3X,F5.1,1X,F6.1,1X,'|',3X,I2,3X,'|',1X,A7,F7.0,
* 1X,F7.0,3X,F7.1,3X,'|')
845 FORMAT (I3,3X,F5.1,1X,F6.1,1X,'|',3X,I2,3X,'|',36X,'|',F7.0)
850 FORMAT (31X,'DECOMPRESSION PROFILE')
851 FORMAT ('Seg-',2X,'Segm.',2X,'Run',3X,'|',1X,'Gasmix',1X,'|',1X,
* 'Ascent',3X,'Ascent',9X,'|',2X,'DECO',3X,'STOP',
* 3X,'RUN')
852 FORMAT ('ment',2X,'Time',3X,'Time',2X,'|',2X,'Used',2X,'|',3X,
* 'To',6X,'Rate',4X,'Grad.',1X,'|',2X,'STOP',3X,'TIME',
* 3X,'TIME')
853 FORMAT (2X,'#',3X,'(min)',2X,'(min)',1X,'|',4X,'#',3X,'|',1X,
* '(',A4,')',1X,'(',A7,')',1X,'Factor',1X,'|',1X,'(',A4,')',
* 2X,'(min)',2X,'(min)')
854 FORMAT ('-----',1X,'-----',2X,'-----',1X,'|',1X,'------',1X,'|',
* 1X,'------',1X,'---------',1X,'------',1X,'|',1X,
* '------',2X,'-----',2X,'-----')
857 FORMAT (10X,'Leading compartment enters the decompression zone',
* 1X,'at',F7.1,1X,A4)
858 FORMAT (17X,'Deepest possible decompression stop is',F7.1,1X,A4)
860 FORMAT (I3,3X,F5.1,1X,F6.1,1X,'|',3X,I2,3X,'|',2X,F4.0,3X,F6.1,
* 10X,'|')
861 FORMAT (48X,F4.2,2X,'|')
862 FORMAT (I3,3X,F5.1,1X,F6.1,1X,'|',3X,I2,3X,'|',19X,F4.2,2X,'|',
* 2X,I4,3X,I4,2X,I5)
863 FORMAT (I3,3X,F5.1,1X,F6.1,1X,'|',3X,I2,3X,'|',19X,F4.2,2X,'|',
* 2X,F5.0,1X,F6.1,1X,F7.1)
871 FORMAT (' PROGRAM CALCULATIONS COMPLETE')
872 FORMAT ('0Output data is located in the files GFDECO.OUT and DIVED
*ATA.OUT')
880 FORMAT ('[insert page break code 012]')
890 FORMAT ('REPETITIVE DIVE:')
891 FORMAT (F8.3)
701 FORMAT (58X,'------',2X,'-----')
702 FORMAT (56X,2P,F7.1,'%',0P,F7.1)
703 FORMAT (59X,'Total',2X,'Total')
704 FORMAT (50X,'with 1.5')
705 FORMAT ('Gasmix Volume Totals:',18X,A6,3X,'safety factor')
706 FORMAT (25X,'Gasmix #',I2,3X,F7.1,5X,F7.1)
600 FORMAT (37X,'DIVE DATA')
601 FORMAT ('Seg-',2X,'Segm.',2X,'Run',3X,'|',1X,'Gasmix',1X,'|',2X,
* 'RMV',2X,'GasVol',3X,'Max',3X,'Max',5X,'CNS',4X,'CPTD',4X,
* 'END',5X,'END')
602 FORMAT ('ment',2X,'Time',3X,'Time',2X,'|',2X,'Used',2X,'|',A5,
* 3X,'Segm.',2X,'Depth',2X,'PO2',5X,'O2 %',3X,
* '(OTU)',3X,'N2',5X,'N2+O2')
603 FORMAT (2X,'#',3X,'(min)',2X,'(min)',1X,'|',4X,'#',3X,'|',1X,
* '/min',2X,A6,2X,'(',A4,')',1X,'Segm.',3X,'Segm.',2X,
* 'Segm.',2X,'(',A4,')',2X,'(',A4,')')
604 FORMAT ('-----',1X,'-----',2X,'-----',1X,'|',1X,'------',1X,'|',
* 1X,'----',2X,'------',2X,'------',1X,'-----',2X,'------',
* 2X,'-----',2X,'------',2X,'------')
610 FORMAT ('Altitude =',F8.1,1X,'feet',4X,'Barometric Pressure =',
* F5.1,1X,'fsw abs. (',F7.2,1X,'millibars)')
611 FORMAT ('Altitude =',F8.1,1X,'meters',4X,'Barometric Pressure =',
* F5.1,1X,'msw abs. (',F7.2,1X,'millibars)')
C===============================================================================
C FORMAT STATEMENTS - ERROR MESSAGES
C===============================================================================
900 FORMAT (' ')
901 FORMAT ('0ERROR! UNITS MUST BE FSW OR MSW')
902 FORMAT ('0ERROR! ALTITUDE DIVE ALGORITHM MUST BE ON OR OFF')
905 FORMAT ('0ERROR! STEP SIZE IS TOO LARGE TO DECOMPRESS')
906 FORMAT ('0ERROR IN INPUT FILE (GASMIX DATA)')
907 FORMAT ('0ERROR IN INPUT FILE (PROFILE CODE)')
908 FORMAT ('0ERROR IN INPUT FILE (REPETITIVE DIVE CODE)')
C===============================================================================
C END OF MAIN PROGRAM
C===============================================================================
END
C===============================================================================
C NOTE ABOUT PRESSURE UNITS USED IN CALCULATIONS:
C It is the convention in decompression calculations to compute all gas
C loadings, absolute pressures, partial pressures, etc., in the units of
C depth pressure that you are diving - either feet of seawater (fsw) or
C meters of seawater (msw). This program follows that convention.
C===============================================================================
C===============================================================================
C FUNCTION SUBPROGRAM FOR GAS LOADING CALCULATIONS - ASCENT AND DESCENT
C===============================================================================
FUNCTION SCHREINER_EQUATION (Initial_Inspired_Gas_Pressure,
*Rate_Change_Insp_Gas_Pressure, Interval_Time, Gas_Time_Constant,
*Initial_Gas_Pressure)
C===============================================================================
C ARGUMENTS
C===============================================================================
REAL Initial_Inspired_Gas_Pressure !input
REAL Rate_Change_Insp_Gas_Pressure !input
REAL Interval_Time, Gas_Time_Constant !input
REAL Initial_Gas_Pressure !input
REAL SCHREINER_EQUATION !output
C===============================================================================
C Note: The Schreiner equation is applied when calculating the uptake or
C elimination of compartment gases during linear ascents or descents at a
C constant rate. For ascents, a negative number for rate must be used.
C===============================================================================
SCHREINER_EQUATION =
*Initial_Inspired_Gas_Pressure + Rate_Change_Insp_Gas_Pressure*
*(Interval_Time - 1.0/Gas_Time_Constant) -
*(Initial_Inspired_Gas_Pressure - Initial_Gas_Pressure -
*Rate_Change_Insp_Gas_Pressure/Gas_Time_Constant)*
*EXP (-Gas_Time_Constant*Interval_Time)
RETURN
END
C===============================================================================
C FUNCTION SUBPROGRAM FOR GAS LOADING CALCULATIONS - CONSTANT DEPTH
C===============================================================================
FUNCTION HALDANE_EQUATION (Initial_Gas_Pressure,
*Inspired_Gas_Pressure, Gas_Time_Constant, Interval_Time)
C===============================================================================
C ARGUMENTS
C===============================================================================
REAL Initial_Gas_Pressure, Inspired_Gas_Pressure !input
REAL Gas_Time_Constant, Interval_Time !input
REAL HALDANE_EQUATION !output
C===============================================================================
C Note: The Haldane equation is applied when calculating the uptake or
C elimination of compartment gases during intervals at constant depth (the
C outside ambient pressure does not change).
C===============================================================================
HALDANE_EQUATION = Initial_Gas_Pressure +
*(Inspired_Gas_Pressure - Initial_Gas_Pressure)*
*(1.0 - EXP(-Gas_Time_Constant * Interval_Time))
RETURN
END
C===============================================================================
C SUBROUTINE GAS_LOADINGS_ASCENT_DESCENT
C Purpose: This subprogram applies the Schreiner equation to update the
C gas loadings (partial pressures of helium and nitrogen) in the half-time
C compartments due to a linear ascent or descent segment at a constant rate.
C===============================================================================
SUBROUTINE GAS_LOADINGS_ASCENT_DESCENT (Starting_Depth,
* Ending_Depth, Rate)
IMPLICIT NONE
C===============================================================================
C ARGUMENTS
C===============================================================================
REAL Starting_Depth, Ending_Depth, Rate !input
C===============================================================================
C LOCAL VARIABLES
C===============================================================================
INTEGER I !loop counter
INTEGER Last_Segment_Number
REAL Initial_Inspired_He_Pressure
REAL Initial_Inspired_N2_Pressure
REAL Last_Run_Time
REAL Helium_Rate, Nitrogen_Rate, Starting_Ambient_Pressure
REAL SCHREINER_EQUATION !function subprogram
C===============================================================================
C GLOBAL CONSTANTS IN NAMED COMMON BLOCKS
C===============================================================================
REAL Water_Vapor_Pressure
COMMON /Block_8/ Water_Vapor_Pressure
C===============================================================================
C GLOBAL VARIABLES IN NAMED COMMON BLOCKS
C===============================================================================
INTEGER Segment_Number !both input
REAL Run_Time, Segment_Time !and output
COMMON /Block_2/ Run_Time, Segment_Number, Segment_Time
REAL Ending_Ambient_Pressure !output
COMMON /Block_4/ Ending_Ambient_Pressure
INTEGER Mix_Number
COMMON /Block_9/ Mix_Number
REAL Barometric_Pressure
COMMON /Block_18/ Barometric_Pressure
C===============================================================================
C GLOBAL ARRAYS IN NAMED COMMON BLOCKS
C===============================================================================
REAL Helium_Time_Constant(16)
COMMON /Block_1A/ Helium_Time_Constant
REAL Nitrogen_Time_Constant(16)
COMMON /Block_1B/ Nitrogen_Time_Constant
REAL Helium_Pressure(16), Nitrogen_Pressure(16) !both input
COMMON /Block_3/ Helium_Pressure, Nitrogen_Pressure !and output
REAL Fraction_Helium(10), Fraction_Nitrogen(10)
COMMON /Block_5/ Fraction_Helium, Fraction_Nitrogen
REAL Initial_Helium_Pressure(16), Initial_Nitrogen_Pressure(16) !output
COMMON /Block_23/ Initial_Helium_Pressure,
* Initial_Nitrogen_Pressure
C===============================================================================
C CALCULATIONS
C===============================================================================
Segment_Time = (Ending_Depth - Starting_Depth)/Rate
Last_Run_Time = Run_Time
Run_Time = Last_Run_Time + Segment_Time
Last_Segment_Number = Segment_Number
Segment_Number = Last_Segment_Number + 1
Ending_Ambient_Pressure = Ending_Depth + Barometric_Pressure
Starting_Ambient_Pressure = Starting_Depth + Barometric_Pressure
Initial_Inspired_He_Pressure = (Starting_Ambient_Pressure -
* Water_Vapor_Pressure)*Fraction_Helium(Mix_Number)
Initial_Inspired_N2_Pressure = (Starting_Ambient_Pressure -
* Water_Vapor_Pressure)*Fraction_Nitrogen(Mix_Number)
Helium_Rate = Rate*Fraction_Helium(Mix_Number)
Nitrogen_Rate = Rate*Fraction_Nitrogen(Mix_Number)
DO I = 1,16
Initial_Helium_Pressure(I) = Helium_Pressure(I)
Initial_Nitrogen_Pressure(I) = Nitrogen_Pressure(I)
Helium_Pressure(I) = SCHREINER_EQUATION
* (Initial_Inspired_He_Pressure, Helium_Rate,
* Segment_Time, Helium_Time_Constant(I),
* Initial_Helium_Pressure(I))
Nitrogen_Pressure(I) = SCHREINER_EQUATION
* (Initial_Inspired_N2_Pressure, Nitrogen_Rate,
* Segment_Time, Nitrogen_Time_Constant(I),
* Initial_Nitrogen_Pressure(I))
END DO
C===============================================================================
C END OF SUBROUTINE
C===============================================================================
RETURN
END
C===============================================================================
C SUBROUTINE GAS_LOADINGS_CONSTANT_DEPTH
C Purpose: This subprogram applies the Haldane equation to update the
C gas loadings (partial pressures of helium and nitrogen) in the half-time
C compartments for a segment at constant depth.
C===============================================================================
SUBROUTINE GAS_LOADINGS_CONSTANT_DEPTH (Depth,
* Run_Time_End_of_Segment)
IMPLICIT NONE
C===============================================================================
C ARGUMENTS
C===============================================================================
REAL Depth, Run_Time_End_of_Segment !input
C===============================================================================
C LOCAL VARIABLES
C===============================================================================
INTEGER I !loop counter
INTEGER Last_Segment_Number
REAL Initial_Helium_Pressure, Initial_Nitrogen_Pressure
REAL Inspired_Helium_Pressure, Inspired_Nitrogen_Pressure
REAL Ambient_Pressure, Last_Run_Time
REAL HALDANE_EQUATION !function subprogram
C===============================================================================
C GLOBAL CONSTANTS IN NAMED COMMON BLOCKS
C===============================================================================
REAL Water_Vapor_Pressure
COMMON /Block_8/ Water_Vapor_Pressure
C===============================================================================
C GLOBAL VARIABLES IN NAMED COMMON BLOCKS
C===============================================================================
INTEGER Segment_Number !both input
REAL Run_Time, Segment_Time !and output
COMMON /Block_2/ Run_Time, Segment_Number, Segment_Time
REAL Ending_Ambient_Pressure !output
COMMON /Block_4/ Ending_Ambient_Pressure
INTEGER Mix_Number
COMMON /Block_9/ Mix_Number
REAL Barometric_Pressure
COMMON /Block_18/ Barometric_Pressure
C===============================================================================
C GLOBAL ARRAYS IN NAMED COMMON BLOCKS
C===============================================================================
REAL Helium_Time_Constant(16)
COMMON /Block_1A/ Helium_Time_Constant
REAL Nitrogen_Time_Constant(16)
COMMON /Block_1B/ Nitrogen_Time_Constant
REAL Helium_Pressure(16), Nitrogen_Pressure(16) !both input
COMMON /Block_3/ Helium_Pressure, Nitrogen_Pressure !and output
REAL Fraction_Helium(10), Fraction_Nitrogen(10)
COMMON /Block_5/ Fraction_Helium, Fraction_Nitrogen
C===============================================================================
C CALCULATIONS
C===============================================================================
Segment_Time = Run_Time_End_of_Segment - Run_Time
Last_Run_Time = Run_Time_End_of_Segment
Run_Time = Last_Run_Time
Last_Segment_Number = Segment_Number
Segment_Number = Last_Segment_Number + 1
Ambient_Pressure = Depth + Barometric_Pressure
Inspired_Helium_Pressure = (Ambient_Pressure -
* Water_Vapor_Pressure)*Fraction_Helium(Mix_Number)
Inspired_Nitrogen_Pressure = (Ambient_Pressure -
* Water_Vapor_Pressure)*Fraction_Nitrogen(Mix_Number)
Ending_Ambient_Pressure = Ambient_Pressure
DO I = 1,16
Initial_Helium_Pressure = Helium_Pressure(I)
Initial_Nitrogen_Pressure = Nitrogen_Pressure(I)
Helium_Pressure(I) = HALDANE_EQUATION
* (Initial_Helium_Pressure, Inspired_Helium_Pressure,
* Helium_Time_Constant(I), Segment_Time)
Nitrogen_Pressure(I) = HALDANE_EQUATION
* (Initial_Nitrogen_Pressure, Inspired_Nitrogen_Pressure,
* Nitrogen_Time_Constant(I), Segment_Time)
END DO
C===============================================================================
C END OF SUBROUTINE
C===============================================================================
RETURN
END
C===============================================================================
C SUBROUTINE CALC_DECO_CEILING
C Purpose: This subprogram calculates the deco ceiling (the safe ascent
C depth) in each compartment, based on M-values modifed by gradient factors,