-
Notifications
You must be signed in to change notification settings - Fork 1
/
vpmdeco.f
3515 lines (3122 loc) · 172 KB
/
vpmdeco.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 VPMDECO
C===============================================================================
C Varying Permeability Model (VPM) Decompression Program in FORTRAN
C
C Author: Erik C. Baker
C
C "DISTRIBUTE FREELY - CREDIT THE AUTHORS"
C
C This program extends the 1986 VPM algorithm (Yount & Hoffman) to include
C mixed gas, repetitive, and altitude diving. Developments to the algorithm
C were made by David E. Yount, Eric B. Maiken, and Erik C. Baker over a
C period from 1999 to 2001. This work is dedicated in remembrance of
C Professor David E. Yount who passed away on April 27, 2000.
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
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 Acknowledgment: Thanks to Kurt Spaugh for recommendations on how to clean
C up the code.
C===============================================================================
IMPLICIT NONE
C===============================================================================
C LOCAL VARIABLES - MAIN PROGRAM
C===============================================================================
CHARACTER M*1, OS_Command*3, Word*7, Units*3
CHARACTER Line1*70, Critical_Volume_Algorithm*3
CHARACTER Units_Word1*4, Units_Word2*7, 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 Segment_Number_Start_of_Ascent, Repetitive_Dive_Flag
LOGICAL Schedule_Converged, Critical_Volume_Algorithm_Off
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 First_Stop_Depth, Critical_Volume_Comparison
REAL Next_Stop, Run_Time_Start_of_Deco_Zone
REAL Critical_Radius_N2_Microns, Critical_Radius_He_Microns
REAL Run_Time_Start_of_Ascent, Altitude_of_Dive
REAL Deco_Phase_Volume_Time, Surface_Interval_Time
REAL Pressure_Other_Gases_mmHg
C===============================================================================
C LOCAL ARRAYS - MAIN PROGRAM
C===============================================================================
INTEGER Mix_Change(10)
REAL Fraction_Oxygen(10)
REAL Depth_Change (10)
REAL Rate_Change(10), Step_Size_Change(10)
REAL Helium_Half_Time(16), Nitrogen_Half_Time(16)
REAL He_Pressure_Start_of_Ascent(16)
REAL N2_Pressure_Start_of_Ascent(16)
REAL He_Pressure_Start_of_Deco_Zone(16)
REAL N2_Pressure_Start_of_Deco_Zone(16)
REAL Phase_Volume_Time (16)
REAL Last_Phase_Volume_Time(16)
C===============================================================================
C GLOBAL CONSTANTS IN NAMED COMMON BLOCKS
C===============================================================================
REAL Water_Vapor_Pressure
COMMON /Block_8/ Water_Vapor_Pressure
REAL Surface_Tension_Gamma, Skin_Compression_GammaC
COMMON /Block_19/ Surface_Tension_Gamma, Skin_Compression_GammaC
REAL Crit_Volume_Parameter_Lambda
COMMON /Block_20/ Crit_Volume_Parameter_Lambda
REAL Minimum_Deco_Stop_Time
COMMON /Block_21/ Minimum_Deco_Stop_Time
REAL Regeneration_Time_Constant
COMMON /Block_22/ Regeneration_Time_Constant
REAL Constant_Pressure_Other_Gases
COMMON /Block_17/ Constant_Pressure_Other_Gases
REAL Gradient_Onset_of_Imperm_Atm
COMMON /Block_14/ Gradient_Onset_of_Imperm_Atm
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
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 Initial_Critical_Radius_He(16)
REAL Initial_Critical_Radius_N2(16)
COMMON /Block_6/ Initial_Critical_Radius_He,
* Initial_Critical_Radius_N2
REAL Adjusted_Critical_Radius_He(16)
REAL Adjusted_Critical_Radius_N2(16)
COMMON /Block_7/ Adjusted_Critical_Radius_He,
* Adjusted_Critical_Radius_N2
REAL Max_Crushing_Pressure_He(16), Max_Crushing_Pressure_N2(16)
COMMON /Block_10/ Max_Crushing_Pressure_He,
* Max_Crushing_Pressure_N2
REAL Surface_Phase_Volume_Time(16)
COMMON /Block_11/ Surface_Phase_Volume_Time
REAL Max_Actual_Gradient(16)
COMMON /Block_12/ Max_Actual_Gradient
REAL Amb_Pressure_Onset_of_Imperm(16)
REAL Gas_Tension_Onset_of_Imperm(16)
COMMON /Block_13/ Amb_Pressure_Onset_of_Imperm,
* Gas_Tension_Onset_of_Imperm
C===============================================================================
C NAMELIST FOR PROGRAM SETTINGS (READ IN FROM ASCII TEXT FILE)
C===============================================================================
NAMELIST /Program_Settings/ Units, Altitude_Dive_Algorithm,
* Minimum_Deco_Stop_Time, Critical_Radius_N2_Microns,
* Critical_Radius_He_Microns, Critical_Volume_Algorithm,
* Crit_Volume_Parameter_Lambda,
* Gradient_Onset_of_Imperm_Atm,
* Surface_Tension_Gamma, Skin_Compression_GammaC,
* Regeneration_Time_Constant, Pressure_Other_Gases_mmHg
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 = 'VPMDECO.IN', STATUS = 'UNKNOWN',
* ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED')
OPEN (UNIT = 8, FILE = 'VPMDECO.OUT', STATUS = 'UNKNOWN',
* ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED')
OPEN (UNIT = 10, FILE = 'VPMDECO.SET', STATUS = 'UNKNOWN',
* ACCESS = 'SEQUENTIAL', FORM = 'FORMATTED')
C===============================================================================
C BEGIN PROGRAM EXECUTION WITH OUTPUT MESSAGE TO SCREEN
C===============================================================================
OS_Command = 'CLS'
CALL SYSTEMQQ (OS_Command) !Pass "clear screen" command
PRINT *,' ' !to MS operating system
PRINT *,'PROGRAM VPMDECO'
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
CALL SYSTEMQQ (OS_Command)
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
IF ((Critical_Radius_N2_Microns .LT. 0.2) .OR.
* (Critical_Radius_N2_Microns .GT. 1.35)) THEN
CALL SYSTEMQQ (OS_Command)
WRITE (*,903)
WRITE (*,900)
STOP 'PROGRAM TERMINATED'
END IF
IF ((Critical_Radius_He_Microns .LT. 0.2) .OR.
* (Critical_Radius_He_Microns .GT. 1.35)) THEN
CALL SYSTEMQQ (OS_Command)
WRITE (*,903)
WRITE (*,900)
STOP 'PROGRAM TERMINATED'
END IF
IF ((Critical_Volume_Algorithm .EQ. 'ON').OR.
* (Critical_Volume_Algorithm .EQ. 'on')) THEN
Critical_Volume_Algorithm_Off = (.FALSE.)
ELSE IF ((Critical_Volume_Algorithm .EQ. 'OFF').OR.
* (Critical_Volume_Algorithm .EQ. 'off')) THEN
Critical_Volume_Algorithm_Off = (.TRUE.)
ELSE
WRITE (*,904)
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_Factor = 33.0
Water_Vapor_Pressure = 1.607 !based on respiratory quotient of 0.8
!(Schreiner value)
END IF
IF (Units_Equal_Msw) THEN
WRITE (*,801)
Units_Word1 = 'mswg'
Units_Word2 = 'msw/min'
Units_Factor = 10.1325
Water_Vapor_Pressure = 0.493 !based on respiratory quotient of 0.8
END IF !(Schreiner value)
C===============================================================================
C INITIALIZE CONSTANTS/VARIABLES
C===============================================================================
Constant_Pressure_Other_Gases = (Pressure_Other_Gases_mmHg/760.0)
* * Units_Factor
Run_Time = 0.0
Segment_Number = 0
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)
Max_Crushing_Pressure_He(I) = 0.0
Max_Crushing_Pressure_N2(I) = 0.0
Max_Actual_Gradient(I) = 0.0
Surface_Phase_Volume_Time(I) = 0.0
Amb_Pressure_Onset_of_Imperm(I) = 0.0
Gas_Tension_Onset_of_Imperm(I) = 0.0
Initial_Critical_Radius_N2(I) = Critical_Radius_N2_Microns
* * 1.0E-6
Initial_Critical_Radius_He(I) = Critical_Radius_He_Microns
* * 1.0E-6
END DO
C===============================================================================
C INITIALIZE VARIABLES FOR SEA LEVEL OR ALTITUDE DIVE
C See subroutines for explanation of altitude calculations. Purposes are
C 1) to determine barometric pressure and 2) set or adjust the VPM critical
C radius variables and gas loadings, as applicable, based on altitude,
C ascent to altitude before the dive, and time at altitude before the 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
Adjusted_Critical_Radius_N2(I) = Initial_Critical_Radius_N2(I)
Adjusted_Critical_Radius_He(I) = Initial_Critical_Radius_He(I)
Helium_Pressure(I) = 0.0
Nitrogen_Pressure(I) = (Barometric_Pressure -
* Water_Vapor_Pressure)*0.79
END DO
ELSE
CALL VPM_ALTITUDE_DIVE_ALGORITHM !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 FILE
C See separate explanation of format for input file.
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)
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
CALL SYSTEMQQ (OS_Command)
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
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)
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 DIVES AND UNUSUAL PROFILES. UPDATE
C GAS LOADINGS FOR EACH SEGMENT. IF IT IS A DESCENT SEGMENT, CALC CRUSHING
C PRESSURE ON CRITICAL RADII IN EACH COMPARTMENT.
C "Instantaneous" descents are not used in the VPM. All ascent/descent
C segments must have a realistic rate of ascent/descent. Unlike Haldanian
C models, the VPM is actually more conservative when the descent rate is
C slower becuase the effective crushing pressure is reduced. Also, a
C realistic actual supersaturation gradient must be calculated during
C ascents as this affects critical radii adjustments for repetitive dives.
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
CALL CALC_CRUSHING_PRESSURE (Starting_Depth, !subroutine
* Ending_Depth, Rate)
END IF
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
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
ELSE IF (Profile_Code .EQ. 99) THEN
EXIT
ELSE
CALL SYSTEMQQ (OS_Command)
WRITE (*,907)
WRITE (*,900)
STOP 'PROGRAM TERMINATED'
END IF
END DO
C===============================================================================
C BEGIN PROCESS OF ASCENT AND DECOMPRESSION
C First, calculate the regeneration of critical radii that takes place over
C the dive time. The regeneration time constant has a time scale of weeks
C so this will have very little impact on dives of normal length, but will
C have major impact for saturation dives.
C===============================================================================
CALL NUCLEAR_REGENERATION (Run_Time) !subroutine
C===============================================================================
C CALCULATE INITIAL ALLOWABLE GRADIENTS FOR ASCENT
C This is based on the maximum effective crushing pressure on critical radii
C in each compartment achieved during the dive profile.
C===============================================================================
CALL CALC_INITIAL_ALLOWABLE_GRADIENT !subroutine
C===============================================================================
C SAVE VARIABLES AT START OF ASCENT (END OF BOTTOM TIME) SINCE THESE WILL
C BE USED LATER TO COMPUTE THE FINAL ASCENT PROFILE THAT IS WRITTEN TO THE
C OUTPUT FILE.
C The VPM uses an iterative process to compute decompression schedules so
C there will be more than one pass through the decompression loop.
C===============================================================================
DO I = 1,16
He_Pressure_Start_of_Ascent(I) = Helium_Pressure(I)
N2_Pressure_Start_of_Ascent(I) = Nitrogen_Pressure(I)
END DO
Run_Time_Start_of_Ascent = Run_Time
Segment_Number_Start_of_Ascent = Segment_Number
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)
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 TEMPORARILY ASCEND PROFILE TO THE START OF THE DECOMPRESSION ZONE, SAVE
C VARIABLES AT THIS POINT, AND INITIALIZE VARIABLES FOR CRITICAL VOLUME LOOP
C The iterative process of the VPM Critical Volume Algorithm will operate
C only in the decompression zone since it deals with excess gas volume
C released as a result of supersaturation gradients (not possible below the
C decompression zone).
C===============================================================================
CALL GAS_LOADINGS_ASCENT_DESCENT (Starting_Depth, !subroutine
* Depth_Start_of_Deco_Zone, Rate)
Run_Time_Start_of_Deco_Zone = Run_Time
Deco_Phase_Volume_Time = 0.0
Last_Run_Time = 0.0
Schedule_Converged = (.FALSE.)
DO I = 1,16
Last_Phase_Volume_Time(I) = 0.0
He_Pressure_Start_of_Deco_Zone(I) = Helium_Pressure(I)
N2_Pressure_Start_of_Deco_Zone(I) = Nitrogen_Pressure(I)
Max_Actual_Gradient(I) = 0.0
END DO
C===============================================================================
C START OF CRITICAL VOLUME LOOP
C This loop operates between Lines 50 and 100. If the Critical Volume
C Algorithm is toggled "off" in the program settings, there will only be
C one pass through this loop. Otherwise, there will be two or more passes
C through this loop until the deco schedule is "converged" - that is when a
C comparison between the phase volume time of the present iteration and the
C last iteration is less than or equal to one minute. This implies that
C the volume of released gas in the most recent iteration differs from the
C "critical" volume limit by an acceptably small amount. The critical
C volume limit is set by the Critical Volume Parameter Lambda in the program
C settings (default setting is 7500 fsw-min with adjustability range from
C from 6500 to 8300 fsw-min according to Bruce Wienke).
C===============================================================================
50 DO 100, WHILE (.TRUE.) !loop will run continuously until
!there is an exit statement
C===============================================================================
C CALCULATE CURRENT DECO CEILING BASED ON ALLOWABLE SUPERSATURATION
C GRADIENTS AND SET FIRST DECO STOP. CHECK TO MAKE SURE THAT SELECTED STEP
C SIZE WILL NOT ROUND UP FIRST STOP TO A DEPTH THAT 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 (Depth_Start_of_Deco_Zone, 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 HANDLE THE SPECIAL CASE WHEN NO DECO STOPS ARE REQUIRED - ASCENT CAN BE
C MADE DIRECTLY TO THE SURFACE
C Write ascent data to output file and exit the Critical Volume Loop.
C===============================================================================
IF (Deco_Stop_Depth .EQ. 0.0) THEN
DO I = 1,16
Helium_Pressure(I) = He_Pressure_Start_of_Ascent(I)
Nitrogen_Pressure(I) = N2_Pressure_Start_of_Ascent(I)
END DO
Run_Time = Run_Time_Start_of_Ascent
Segment_Number = Segment_Number_Start_of_Ascent
Starting_Depth = Depth_Change(1)
Ending_Depth = 0.0
CALL GAS_LOADINGS_ASCENT_DESCENT (Starting_Depth, !subroutine
* Ending_Depth, Rate)
WRITE (8,860) Segment_Number, Segment_Time, Run_Time,
* Mix_Number, Deco_Stop_Depth, Rate
EXIT !exit the critical volume loop at Line 100
END IF
C===============================================================================
C ASSIGN VARIABLES FOR ASCENT FROM START OF DECO ZONE TO FIRST STOP. SAVE
C FIRST STOP DEPTH FOR LATER USE WHEN COMPUTING THE FINAL ASCENT PROFILE
C===============================================================================
Starting_Depth = Depth_Start_of_Deco_Zone
First_Stop_Depth = Deco_Stop_Depth
C===============================================================================
C DECO STOP LOOP BLOCK WITHIN CRITICAL VOLUME LOOP
C This loop computes a decompression schedule to the surface during each
C iteration of the critical volume loop. No output is written from this
C loop, rather it computes a schedule from which the in-water portion of the
C total phase volume time (Deco_Phase_Volume_Time) can be extracted. Also,
C the gas loadings computed at the end of this loop are used the subroutine
C which computes the out-of-water portion of the total phase volume time
C (Surface_Phase_Volume_Time) for that schedule.
C
C Note that exit is made from the loop after last ascent is made to a deco
C stop depth that is less than or equal to zero. A final deco stop less
C than zero can happen when the user makes an odd step size change during
C ascent - such as specifying a 5 msw step size change at the 3 msw stop!
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)
IF (Deco_Stop_Depth .LE. 0.0) EXIT !exit at Line 60
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
CALL DECOMPRESSION_STOP (Deco_Stop_Depth, Step_Size) !subroutine
Starting_Depth = Deco_Stop_Depth
Next_Stop = Deco_Stop_Depth - Step_Size
Deco_Stop_Depth = Next_Stop
Last_Run_Time = Run_Time
60 END DO !end of deco stop loop block
C===============================================================================
C COMPUTE TOTAL PHASE VOLUME TIME AND MAKE CRITICAL VOLUME COMPARISON
C The deco phase volume time is computed from the run time. The surface
C phase volume time is computed in a subroutine based on the surfacing gas
C loadings from previous deco loop block. Next the total phase volume time
C (in-water + surface) for each compartment is compared against the previous
C total phase volume time. The schedule is converged when the difference is
C less than or equal to 1 minute in any one of the 16 compartments.
C
C Note: the "phase volume time" is somewhat of a mathematical concept.
C It is the time divided out of a total integration of supersaturation
C gradient x time (in-water and surface). This integration is multiplied
C by the excess bubble number to represent the amount of free-gas released
C as a result of allowing a certain number of excess bubbles to form.
C===============================================================================
Deco_Phase_Volume_Time = Run_Time - Run_Time_Start_of_Deco_Zone
CALL CALC_SURFACE_PHASE_VOLUME_TIME !subroutine
DO I = 1,16
Phase_Volume_Time(I) = Deco_Phase_Volume_Time +
* Surface_Phase_Volume_Time(I)
Critical_Volume_Comparison = ABS(Phase_Volume_Time(I) -
* Last_Phase_Volume_Time(I))
IF (Critical_Volume_Comparison .LE. 1.0) THEN
Schedule_Converged = (.TRUE.)
END IF
END DO
C===============================================================================
C CRITICAL VOLUME DECISION TREE BETWEEN LINES 70 AND 99
C There are two options here. If the Critical Volume Agorithm setting is
C "on" and the schedule is converged, or the Critical Volume Algorithm
C setting was "off" in the first place, the program will re-assign variables
C to their values at the start of ascent (end of bottom time) and process
C a complete decompression schedule once again using all the same ascent
C parameters and first stop depth. This decompression schedule will match
C the last iteration of the Critical Volume Loop and the program will write
C the final deco schedule to the output file.
C
C Note: if the Critical Volume Agorithm setting was "off", the final deco
C schedule will be based on "Initial Allowable Supersaturation Gradients."
C If it was "on", the final schedule will be based on "Adjusted Allowable
C Supersaturation Gradients" (gradients that are "relaxed" as a result of
C the Critical Volume Algorithm).
C
C If the Critical Volume Agorithm setting is "on" and the schedule is not
C converged, the program will re-assign variables to their values at the
C start of the deco zone and process another trial decompression schedule.
C===============================================================================
70 IF ((Schedule_Converged) .OR.
* (Critical_Volume_Algorithm_Off)) THEN
DO I = 1,16
Helium_Pressure(I) = He_Pressure_Start_of_Ascent(I)
Nitrogen_Pressure(I) = N2_Pressure_Start_of_Ascent(I)
END DO
Run_Time = Run_Time_Start_of_Ascent
Segment_Number = Segment_Number_Start_of_Ascent
Starting_Depth = Depth_Change(1)
Mix_Number = Mix_Change(1)
Rate = Rate_Change(1)
Step_Size = Step_Size_Change(1)
Deco_Stop_Depth = First_Stop_Depth
Last_Run_Time = 0.0
C===============================================================================
C DECO STOP LOOP BLOCK FOR FINAL 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)
C===============================================================================
C DURING FINAL DECOMPRESSION SCHEDULE PROCESS, COMPUTE MAXIMUM ACTUAL
C SUPERSATURATION GRADIENT RESULTING IN EACH COMPARTMENT
C If there is a repetitive dive, this will be used later in the VPM
C Repetitive Algorithm to adjust the values for critical radii.
C===============================================================================
CALL CALC_MAX_ACTUAL_GRADIENT (Deco_Stop_Depth) !subroutine
WRITE (8,860) Segment_Number, Segment_Time, Run_Time,
* Mix_Number, Deco_Stop_Depth, Rate
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
CALL DECOMPRESSION_STOP (Deco_Stop_Depth, Step_Size) !subroutine
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 DURING FINAL DECOMPRESSION SCHEDULE, IF MINIMUM STOP TIME PARAMETER IS A
C WHOLE NUMBER (i.e. 1 minute) THEN WRITE DECO SCHEDULE USING INTEGER
C NUMBERS (looks nicer). OTHERWISE, USE 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, INT(Deco_Stop_Depth),
* INT(Stop_Time), INT(Run_Time)
ELSE
WRITE (8,863) Segment_Number, Segment_Time, Run_Time,
* Mix_Number, Deco_Stop_Depth, Stop_Time,
* Run_Time
END IF
Starting_Depth = Deco_Stop_Depth
Next_Stop = Deco_Stop_Depth - Step_Size
Deco_Stop_Depth = Next_Stop
Last_Run_Time = Run_Time
80 END DO !end of deco stop loop block
!for final deco schedule
EXIT !exit critical volume loop at Line 100
!final deco schedule written
ELSE
C===============================================================================
C IF SCHEDULE NOT CONVERGED, COMPUTE RELAXED ALLOWABLE SUPERSATURATION
C GRADIENTS WITH VPM CRITICAL VOLUME ALGORITHM AND PROCESS ANOTHER
C ITERATION OF THE CRITICAL VOLUME LOOP
C===============================================================================
CALL CRITICAL_VOLUME (Deco_Phase_Volume_Time) !subroutine
Deco_Phase_Volume_Time = 0.0
Run_Time = Run_Time_Start_of_Deco_Zone
Starting_Depth = Depth_Start_of_Deco_Zone
Mix_Number = Mix_Change(1)
Rate = Rate_Change(1)
Step_Size = Step_Size_Change(1)
DO I = 1,16
Last_Phase_Volume_Time(I) = Phase_Volume_Time(I)
Helium_Pressure(I) = He_Pressure_Start_of_Deco_Zone(I)
Nitrogen_Pressure(I) = N2_Pressure_Start_of_Deco_Zone(I)
END DO
CYCLE !Return to start of critical volume loop
!(Line 50) to process another iteration
99 END IF !end of critical volume decision tree
100 CONTINUE !end of critical volume loop
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. ADJUST CRITICAL RADII USING VPM REPETITIVE
C ALGORITHM. RE-INITIALIZE SELECTED VARIABLES AND RETURN TO START OF
C 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
CALL VPM_REPETITIVE_ALGORITHM (Surface_Interval_Time) !subroutine
DO I = 1,16
Max_Crushing_Pressure_He(I) = 0.0
Max_Crushing_Pressure_N2(I) = 0.0
Max_Actual_Gradient(I) = 0.0
END DO
Run_Time = 0.0
Segment_Number = 0
WRITE (8,880)
WRITE (8,890)
WRITE (8,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
CALL SYSTEMQQ (OS_Command)
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)
CLOSE (UNIT = 7, STATUS = 'KEEP')
CLOSE (UNIT = 8, STATUS = 'KEEP')
CLOSE (UNIT = 10, 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 ('E&a10L&l80F&l8D(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: VPM 2001')
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',3X,'Col',3X,'|',2X,'DECO',3X,'STOP',
* 3X,'RUN')
852 FORMAT ('ment',2X,'Time',3X,'Time',2X,'|',2X,'Used',2X,'|',3X,
* 'To',6X,'Rate',4X,'Not',3X,'|',2X,'STOP',3X,'TIME',3X,
* 'TIME')
853 FORMAT (2X,'#',3X,'(min)',2X,'(min)',1X,'|',4X,'#',3X,'|',1X,
* '(',A4,')',1X,'(',A7,')',2X,'Used',2X,'|',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,'|')
862 FORMAT (I3,3X,F5.1,1X,F6.1,1X,'|',3X,I2,3X,'|',25X,'|',2X,I4,3X,
* I4,2X,I5)
863 FORMAT (I3,3X,F5.1,1X,F6.1,1X,'|',3X,I2,3X,'|',25X,'|',2X,F5.0,1X,
* F6.1,1X,F7.1)
871 FORMAT (' PROGRAM CALCULATIONS COMPLETE')
872 FORMAT ('0Output data is located in the file VPMDECO.OUT')
880 FORMAT (' ')
890 FORMAT ('REPETITIVE DIVE:')
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')
903 FORMAT ('0ERROR! RADIUS MUST BE BETWEEN 0.2 AND 1.35 MICRONS')
904 FORMAT ('0ERROR! CRITICAL VOLUME 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 with the
C the exception that all VPM calculations are performed in SI units (by
C necessity). Accordingly, there are several conversions back and forth
C between the diving pressure units and the SI units.
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