/[lmdze]/trunk/bibio/formcoord.f90
ViewVC logotype

Diff of /trunk/bibio/formcoord.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/bibio/formcoord.f revision 80 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/bibio/formcoord.f90 revision 81 by guez, Wed Mar 5 14:38:41 2014 UTC
# Line 1  Line 1 
 !  
 ! $Header: /home/cvsroot/LMDZ4/libf/bibio/formcoord.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $  
 !  
       subroutine formcoord(unit,n,x,a,rev,text)  
       implicit none  
       integer n,unit,ndec  
       logical rev  
       real x(n),a  
       character*4 text  
   
       integer i,id,i1,i2,in  
       real dx,dxmin  
   
       if(rev) then  
          id=-1  
          i1=n  
          i2=n-1  
          in=1  
          write(unit,3000) text(1:1)  
       else  
          id=1  
          i1=1  
          i2=2  
          in=n  
       endif  
   
       if (n.lt.2) then  
          ndec=1  
          write(unit,1000) text,n,x(1)*a  
       else  
          dxmin=abs(x(2)-x(1))  
          do i=2,n-1  
             dx=abs(x(i+1)-x(i))  
             if (dx.lt.dxmin) dxmin=dx  
          enddo  
   
          ndec=-log10(dxmin)+2  
          if(mod(n,6).eq.1) then  
             write(unit,1000) text,n,x(i1)*a  
             write(unit,2000) (x(i)*a,i=i2,in,id)  
          else  
             write(unit,1000) text,n  
             write(unit,2000) (x(i)*a,i=i1,in,id)  
          endif  
       endif  
   
 1000  format(a4,2x,i4,' LEVELS',43x,f12.2)  
 2000  format(6f12.2)  
 c1000  format(a4,2x,i4,' LEVELS',43x,f12.<ndec>)  
 c2000  format(6f12.<ndec>)  
 3000  format('FORMAT ',a1,'REV')  
       return  
1    
2        end  ! $Header: /home/cvsroot/LMDZ4/libf/bibio/formcoord.F,v 1.1.1.1 2004/05/19
3    ! 12:53:05 lmdzadmin Exp $
4    
5    SUBROUTINE formcoord(unit, n, x, a, rev, text)
6      IMPLICIT NONE
7      INTEGER n, unit, ndec
8      LOGICAL rev
9      REAL x(n), a
10      CHARACTER *4 text
11    
12      INTEGER i, id, i1, i2, in
13      REAL dx, dxmin
14    
15      IF (rev) THEN
16        id = -1
17        i1 = n
18        i2 = n - 1
19        in = 1
20        WRITE (unit, 3000) text(1:1)
21      ELSE
22        id = 1
23        i1 = 1
24        i2 = 2
25        in = n
26      END IF
27    
28      IF (n<2) THEN
29        ndec = 1
30        WRITE (unit, 1000) text, n, x(1)*a
31      ELSE
32        dxmin = abs(x(2)-x(1))
33        DO i = 2, n - 1
34          dx = abs(x(i+1)-x(i))
35          IF (dx<dxmin) dxmin = dx
36        END DO
37    
38        ndec = -log10(dxmin) + 2
39        IF (mod(n,6)==1) THEN
40          WRITE (unit, 1000) text, n, x(i1)*a
41          WRITE (unit, 2000)(x(i)*a, i=i2, in, id)
42        ELSE
43          WRITE (unit, 1000) text, n
44          WRITE (unit, 2000)(x(i)*a, i=i1, in, id)
45        END IF
46      END IF
47    
48    1000 FORMAT (A4, 2X, I4, ' LEVELS', 43X, F12.2)
49    2000 FORMAT (6F12.2)
50      ! 1000  format(a4,2x,i4,' LEVELS',43x,f12.<ndec>)
51      ! 2000  format(6f12.<ndec>)
52    3000 FORMAT ('FORMAT ', A1, 'REV')
53      RETURN
54    
55    END SUBROUTINE formcoord
Legend:
Removed from v.80  
changed lines
  Added in v.81
  ViewVC Help
Powered by ViewVC 1.1.21