C----------------------------------------------------------------		
C  zu (2): Ausgabe reeller Zahlen mit 15 Nachkommastellen 
C          (insgesamt 25 Zeichen)

	write(*,'(3e25.15)') x,y,z
C d.h. 3-mal 25 Zeichen mit 15 Nachkommastellen	
C andere Schreibweise dafuer:

	write(*,100) x,y,z
100	Format(3e25.15)

C----------------------------------------------------------------		
C  Vorsichtsmassnahme: 
C  erzwingt, dass alle Variablen vereinbart werden muessen     
C  jeweils nach der Programmkopfzeile einfuegen:

	IMPLICIT NONE

C----------------------------------------------------------------		
C  zu (3): Rest bei Division  (modulo-Funktion)

        p = MOD(J,19)

C----------------------------------------------------------------		
C  zu (3): Fallunterscheidung mittels IF-THEN

        IF (A .EQ. 202 .or. A .EQ. 204 .or. A .EQ. 205) THEN
          ...
        ENDIF   

C----------------------------------------------------------------		
C  zu (3): Ausgabe einer ausgewhelten Zeichenkette
                entweder                      !     oder:

	CHARACTER*5 Monat(2)                  !     Monat(3:4)
	DATA Monat / "Maerz","April" /
	...
	m=...          !  3 oder 4

	write(*,*) tag,". ",Monat(m-2)        !     Monat(m)


C----------------------------------------------------------------
C zu (3): spezielle Form der IF-Anweisung bei Fallunterscheidungen

	....
	IF ((J .GE. 1582) .AND. (J .LT. 1700)) THEN
	  D=10
	  A=202
	ELSE IF (J .GE. 1700 .AND. J .LT. 1800) THEN
	  D=11
	  A=203
	ELSE IF ( ...................) THEN
	  ......
	  ......
	ELSE IF (J .GE. 2300 .AND. J .LT. 2400) THEN 
	  D=16
	  A=206
	ELSE
	  write(*,*) "Jahreszahl ",J," liegt ausserhalb ..."
	  STOP
	ENDIF
	...

C----------------------------------------------------------------
C zu (3): andere mehr oder weniger elegante Auswertung der Tabelle
C         durch Inkrementierung von A und D
C         (Zulaessigkeit der Jahreszahl vorher ueberpruefen)

	D=10
	A=202
	IF (J .GE. 1700) THEN
	  D=D+1
	  A=A+1
	ENDIF
	IF (J .GE. 1800) THEN
	  D=D+1
	ENDIF
	IF (J .GE. 1900) THEN
	  D=D+1
	  A=A+1
	ENDIF
	.....  usw.

C----------------------------------------------------------------

C----------------------------------------------------------------
C zu (4) Feststellen, ob es ein Schaltjahr ist = logische Funktion

	LOGICAL FUNCTION schaltjahr(j)
	integer j
	logical s
	s=mod(j,4) .EQ. 0
	if (s) then
	  s=(mod(j,400) .EQ. 0) .OR. (mod(j,100) .NE. 0)
	endif
	schaltjahr = s
	return
	END  

C----------------------------------------------------------------
C zu (4) Bsp. zur "uebersichtlichen" Bestimmung des lfd. Tages aus Datum
		
	INTEGER FUNCTION lfdtag(tag,monat,jahr)
	
	IMPLICIT NONE
	
	integer tag,monat,jahr
	integer i,tage(12)  
	logical schaltjahr
	data tage /0,31,28,31,30,31,30,31,31,30,31,30/
C                     J  F  M  A  M  J  J  A  S  O  N
	
	lfdtag=tag
	DO i=1,monat	
           lfdtag = lfdtag + tage(i)
	END DO
	if (monat .GT. 2 .AND. schaltjahr(jahr)) lfdtag=lfdtag+1
C	  ...

C-- oder --
        ...
	data tage /0,31,59,90,120,151,181,212,243,273,304,334/
C                     J  F  M   A   M   J   J   A   S   O   N
        lfdtag=tag+tage(monat)
	...

C----------------------------------------------------------------
C zu (4): Unterprogrammaufruf (nicht als FUNCTION) zur Rueckgabe 
C         eines Feldes
C Hauptprogramm:
          INTEGER zaehler(0:6), jahr  ! oder:   zaehler(7)
	  ...
	  call Freitag(jahr,zaehler)
	  ...
	  
C Unterprogramm
          SUBROUTINE Freitag(j,z)
	  INTEGER j, z(0:6)
	  ! gleicher Anfangswert fuer alle Feldelemente:
	  z=0              ! in F77 so nicht erlaubt, sondern !
	  		   !  do j=0,6
	  		   !    z(j)=0
	  		   !  enddo
	  
	  ....
	  z(w)=z(w)+1
	  ....
	  
	  RETURN
	  END	  

C----------------------------------------------------------------
C zu (4): Schachtelung von Zaehlschleifen, z.B.

	DO jahr = j_erstes, j_letztes
	   ! evtl. Anweisungen (zaehler 0 setzen)
	   ! diese innere Schleife koennte ersetzt werden durch 
	   ! call Freitag(jahr,zaehler)
	   DO monat = 1,12
	        ...
	      ! Anweisungen
	        ...
	   ENDDO
	   ! evtl. Anweisungen (write)
	ENDDO      

C----------------------------------------------------------------

C----------------------------------------------------------------
C zu (5): Definition einer rekursiven Funktion in F90

       RECURSIVE INTEGER FUNCTION fak(n) RESULT(nfak)
       INTEGER n,nfak
       IF (n .LE. 1) THEN
         nfak=1
       ELSE
         nfak=n*fak(n-1)
       ENDIF
       return
       END 
C----------------------------------------------------------------

C----------------------------------------------------------------
C zu (6): Indizes in Formeln bedeuten nicht, dass man dafuer
C         indizierte Variable verwenden muss!
C         (Index bedeutet hier nur "zeitliche Reihenfolge")
C
C         Ebenso muss Variable in der Formel und im Programm 
C         nicht dasselbe sein, z.B. ist es sinnvoll, das 
C         Quadrat von s als Variable zu speichern

C   n = 2, 4, 8, 16, 32, ... , 2**30
C   --------------------------------

      n=2
      s2=4.0		! Variable speichert (s[n]**2)
      DO k=2,30
        n=n+n		! oder   2*n
	s2=...
	pi=...
	write(*,*) n,pi  ! oder  k,pi

C----------------------------------------------------------------
C zu (6):  Partialsummen, z.B. 1/(2**k)
C   Der jeweilige Summand wird aus dem Wert des vorherigen berechnet
 
C Startwerte der Summanden fuer k=0
	sb=1.
	sc=1.

C Startwerte der Summen fuer k=0
	a=0. 
	b=sb
	c=sc
	
	DO n=1,Nmax
      
          sb = 0.5*sb
	  sc = sc/float(n)
	  
	  a = a+1./((n+1.)*n)
	  b = b+sb
	  c = c+sc
 	...
	
C----------------------------------------------------------------
C zu (7):  Zeichenkettenvereinbarung ("pseudovariable" Laenge)
	INTEGER NMAX, NZ
	PARAMETER (NMAX=100, NZ=30)
	CHARACTER*(NZ) NAMEN(NMAX), WORT
	INTEGER j,n,IND(NMAX),L(NMAX)	! Indexvektor fuer Permutation
	LOGICAL WEITER
	
	............
	DO j=1,NMAX
	  IND(j)=j
	ENDDO
	............

C Einlesen mit unterschiedlichen Abbruchkriterien	
	WEITER=.TRUE.
	n=0
	DO WHILE (WEITER)
	  READ(*,'(A)',END=100) WORT
	  WEITER = (WORT(1:1) .NE. '#') .AND. (Len_Trim(WORT) .GT. 0) 
	  if (WEITER) THEN
	    n=n+1
	    NAMEN(n)=WORT
	    L(n)=Len_Trim(WORT)
	    WEITER = (n .LT. NMAX)
          endif
	ENDDO
100	CONTINUE
	write(*,*) 'Eingelesene Woerter:', n	
	
C (indirekter) Zugriff auf j-ten Begriff, z.B.
C  Vertauschen von 2 Woertern durch Vertauschen der Indizes
C  fuer j von 1 bis n-1  und  k von j+1 bis n :

        ............
	if ( LLT( NAMEN(IND(k)),NAMEN(IND(j)) )	) then
	  i=IND(j)
	  IND(j)=IND(k)
	  IND(k)=i
	endif
        ............ 

C  Wenig anders ist es beim sofortigen Einsortieren des gerade
C  gelesenen (n+1)-ten Wortes

        sort: DO k=n,1,-1
	  if (LLT(Liste(n+1),Liste(ind(k)))) then
	   ind(k+1)=ind(k)
	   ind(k)=n+1
	  else
	   ind(k+1)=n+1
	   exit sort
	  endif
	ENDDO sort 	 	 
	n=n+1


C Ausgabe in ermittelter Sortierreihenfolge

        DO j=1,n
	  write(*,*) j,': ', NAMEN(IND(j)), ',' 
	ENDDO

        ............
C Komprimierung der Ausgabe zeilenweise
	Zeile=' '
	LZ=Len(Zeile)
	LX=0
	DO j=1,n
	  k=IND(j)
	  Lrest=LZ-LX
	  if (L(k) .GT. Lrest) then	! Zeile wuerde zu lang
	     write(*,*) Zeile(1:LX)
 	     Zeile=' '
             LX=0
             Lrest=LZ
	  endif
	  Zeile(LX+1:)=NAMEN(k)(:L(k)) // ","   
	  LX=Len_Trim(Zeile)
        ENDDO
        write(*,*) Zeile(1:LX)
        ............
        
C----------------------------------------------------------------
C zu (8):  Anfangswertzuweisung bei grossen Feldern

        integer,parameter :: nmax=100, n=4,m=2,nm=n+m, nm2=nmax*nmax
	integer i,j
	
C alle Elemente gleich
        integer,target,dimension(namx,nmax):: matrix
	data matrix / nm2*0 /

C oder verschieden
        integer,target,dimension(nm2):: vektor
     +         =(/ ((nmax*i+j,i=1,nmax),j=1,nmax) /)


C----------------------------------------------------------------
C zu (9):  Simpsonregel

C   Anfangswert fuer Summation aus den Intervallgrenzen
        S=f(a)+f(b)       ! d.h. k=0 und k=2*n
C    --------------
C   Bestimmung der alternierenden Koeffizienten c_k
        ...
	c = 4.0           ! Startwert fuer k=1
	DO k=1,2*n-1
	  xk= ...
           ! c * f(xk)  aufsummieren 
	  c = 6.0-c       ! 4->2   oder   2->4
        ENDDO
C    --------------
C oder mit "Verdopplung" des Quelltextes: 2 Schleifen 
C - ungerade Indizes (step 2)
	DO k=1,2*n-1,2
	  xk= ...
           ! 4 * f(xk)  aufsummieren 
        ENDDO
C - gerade Indizes (step 2)
	DO k=2,2*n-2,2
	  xk= ...
           ! 2 * f(xk)  aufsummieren 
        ENDDO
C    --------------
C oder mit Schrittweite 2 jeweils 2 Summanden
C       Startwert muss neben Intervallgrenzen auch x(1) enthalten
        S=f(a)+f(b)+4*f(xk)	! mit xk=x(1)
        ...
	DO k=2,2*n-2
	  xk = ...        ! x(k)
	  xk1= ...        ! x(k+1)
          S=S+2.*f(xk)+4.*f(xk1) 
        ENDDO

