CASE - Konstrukt

Erlaubt die übersichtliche Codierung von Fallunterscheidungen;
Im Unterschied zu IF - THEN - ELSE wird nur ein Ausdruck ausgewertet und abhängig vom Wert können dann unterschiedliche Anweisungsblöcke ausgeführt werden.

[name:] SELECT CASE (case_ausdruck)
         [CASE (case_bereich) [name]
           anweisungen]
          ...
         [CASE DEFAULT [name]
           anweisungen]
        END SELECT [name]

Der "case_ausdruck" muß ein aufzählbarer Typ sein: INTEGER, LOGICAL oder CHARACTER;
Der "case_bereich" ist entweder ein Wert oder ein Teilbereich aus dem Wertebereich von "case_ausdruck":

case_wert	ein Wert aus dem Wertebereich von "case_ausdruck"
case_wert:	alle Werte >= "case_wert" im Bereich von "case_ausdruck"
:case_wert	alle Werte <= "case_wert" im Bereich von "case_ausdruck"
case_wert1:case_wert2	alle Werte >= "case_wert1" und <= "case_wert2"

Beispiel: (CASE und Block-IF)

PROGRAM wasserstand
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!  Programm zur Berechnung der neuen Wasserhoehe in einem Wuerfel nach Ein-    !
!  tauchen einer Kugel                                                         !
!  Daten:                                                                      !
!  s      Kantenlaenge des Wuerfels                                            !
!  h      Wasserhoehe im Wuerfel                                               !
!  r      Radius der Kugel                                                     !
!  sh     Soll-Lage des Kugelmittelpunktes                                     !
!  hneu   Wasserhoehe nach Eintauchen der Kugel                                !
!  Loesungsweg:                                                                !
!  1.     Eingabe der notwendigen Daten                                        !
!         Plausibilitaetspruefung                                              !
!         Beachtung moeglicher Sonderfaelle                                    !
!  2.     WENN Sonderfall DANN                                                 !
!          Sonderfall anzeigen                                                 !
!         SONST                                                                !
!          iterative Berechnung der neuen Wasserhoehe                          !
!          Pruefung auf Wasserueberlauf                                        !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
IMPLICIT NONE
PARAMETER (pi = 3.14159)
REAL      :: r, s, h, k, sh, hneu
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
schleife: DO
 WRITE (*,'(a)',ADVANCE='NO') 'Gib s, h, r, sh ein: '
 READ (*,*,IOSTAT = iostat) s, h, r, sh
 SELECT CASE (iostat)
  CASE (:-1)
   EXIT schleife
  CASE (1:)
   WRITE (*,*) 'keine sinnvolle Eingabe'
   CYCLE schleife
  CASE DEFAULT ! iostat = 0
   IF (s<0 .OR. h<0 .OR. r<0 .OR. sh<0) THEN
    WRITE (*,*) 'nur positive Werte eingeben! '
    CYCLE schleife
   ELSE
    IF (sh-r >= h) THEN
     WRITE (*,*) 'Kugel taucht nicht ein'
    ELSE IF (h > s) THEN
     WRITE (*,*) 'Wasserhoehe zu grosz'
    ELSE IF (sh < r) THEN
     WRITE (*,*) 'Kugel wird zerdrueckt'
    ELSE IF (((sh<=s) .AND. (s<2.0*r)) .OR. &
             ((sh>s) .AND. (s<2.0*sqrt(r**2.-(sh-s)**2.)))) THEN
     WRITE (*,*) 'Kugel ist zu grosz'
    ELSE
     vk = 4./3. * pi * r**3.
     IF (sh+r <= h) THEN
      hneu = h + vk/s**2.
     ELSE
      hneu = h
      halt = 0.0
      DO WHILE (abs(hneu-halt) > 0.00001)
       halt = hneu
       IF (sh < halt) THEN
        k = MAX(0.0,(sh+r) - halt)                  ! groszer Teil taucht unter
        v1 = vk - 1./3. * pi * k**2. * (3.*r - k)
       ELSE
        k = MAX(0.0,halt - (sh-r))                  ! kleiner Teil taucht unter
        v1 = 1./3. * pi * k**2. * (3.*r - k)
       ENDIF
       hneu = h + v1/s**2.
      ENDDO
     ENDIF
     IF (hneu > s) THEN
      WRITE (*,*) 'Wasserueberlauf'
     ELSE
      IF (hneu > sh+r) WRITE (*,*) 'Kugel taucht ganz ein'
      WRITE (*,*) 'neuer Wasserstand = ' ,hneu
     ENDIF
    ENDIF
   ENDIF
 END SELECT
ENDDO schleife
END PROGRAM wasserstand