1 |
|
|
SUBROUTINE dump2ds(im,jm,z,nom_z) |
2 |
|
|
C Copyright (C) 2005 Centre National de la Recherche Scientifique |
3 |
|
|
c ================================================================== |
4 |
|
|
c Perform a scatter plot print of big matrices using regular |
5 |
|
|
c intervals between min and max matrix coefficient values. |
6 |
|
|
c ================================================================== |
7 |
|
|
c adapted from LMD3 by Alain Lahellec and retranscipted for LMDZ5 |
8 |
|
|
c NAN et INF ajoute aux plots Pat fin 2006 |
9 |
|
|
c ================================================================== |
10 |
|
|
c Comme dump2d sauf que le signe est pr�serv�, la valeur zero |
11 |
|
|
c identifiee par un blanc. |
12 |
|
|
c detection des Infty (= ou -) et NaN (?) |
13 |
|
|
c ================================================================== |
14 |
|
|
IMPLICIT NONE |
15 |
|
|
INTEGER im,jm |
16 |
|
|
REAL z(im,jm),az |
17 |
|
|
CHARACTER*32 jform,jline*1000 |
18 |
|
|
CHARACTER*1 iform(32) |
19 |
|
|
CHARACTER*16 F1000 |
20 |
|
|
logical zinf,znan,zsign |
21 |
|
|
CHARACTER (len=*) :: nom_z |
22 |
|
|
INTEGER*4 icheck(2) |
23 |
|
|
EQUIVALENCE(az,icheck) |
24 |
|
|
EQUIVALENCE(iform,jform) |
25 |
|
|
DATA jform/'-@zyxwvutsrqpon NOPQRSTUVWXYZ*+?'/ |
26 |
|
|
INTEGER i,j,k,imin,imax,jmin,jmax,kzero,kchar(im) |
27 |
|
|
REAL zmin,zmax,zllu,zllm |
28 |
|
|
write(F1000,'(''(4x,'',I3,''(1H-))'')')im+3 |
29 |
|
|
DO 10001 i=1,200 |
30 |
|
|
jline(1+(i-1)*5:5*i)='. ' |
31 |
|
|
10001 CONTINUE |
32 |
|
|
10002 zmin=z(1,1) |
33 |
|
|
imin=1 |
34 |
|
|
jmin=1 |
35 |
|
|
zmax=z(1,1) |
36 |
|
|
imax=1 |
37 |
|
|
jmax=1 |
38 |
|
|
kzero=0 |
39 |
|
|
DO 10003 j=1,jm |
40 |
|
|
DO 10005 i=1,im |
41 |
|
|
IF(.NOT.( z(i,j).GT.zmax))GOTO 10007 |
42 |
|
|
zmax=z(i,j) |
43 |
|
|
imax=i |
44 |
|
|
jmax=j |
45 |
|
|
10007 IF(.NOT.( z(i,j).LT.zmin))GOTO 10009 |
46 |
|
|
zmin=z(i,j) |
47 |
|
|
imin=i |
48 |
|
|
jmin=j |
49 |
|
|
10009 IF(.NOT.( z(i,j).eq.0.))GOTO 10011 |
50 |
|
|
kzero=kzero+1 |
51 |
|
|
10011 CONTINUE |
52 |
|
|
10005 CONTINUE |
53 |
|
|
10006 CONTINUE |
54 |
|
|
10003 CONTINUE |
55 |
|
|
10004 zsign=(sign(1.,zmin)*sign(1.,zmax).gt.0.) |
56 |
|
|
WRITE(*,*)'>>> dump2ds: ',trim(nom_z) |
57 |
|
|
PRINT*,'>>> ',kzero,' zero values <<<' |
58 |
|
|
IF(.NOT.( ZMin.lt.0.))GOTO 10013 |
59 |
|
|
PRINT2000,' [MIN:',zmin,'(',imin,',',jmin,') (-@zyxwvutsrqpon NOPQ |
60 |
|
|
*RSTUVWXYZ*+) ',zmax,'(',imax,',',jmax,'):MAX]' |
61 |
|
|
GOTO 10014 |
62 |
|
|
10013 PRINT2000,' [MIN:',zmin,'(',imin,',',jmin,') ( NOPQRSTUVWXYZ*+) ', |
63 |
|
|
*zmax,'(',imax,',',jmax,'):MAX]' |
64 |
|
|
10014 CONTINUE |
65 |
|
|
2000 Format(a,1pg11.4,a1,i3,a1,i3,a,1pg11.4,a1,i3,a1,i3,a) |
66 |
|
|
IF(.NOT.( zmax.GT.zmin))GOTO 10015 |
67 |
|
|
zllm=max(abs(zmax),abs(zmin)) |
68 |
|
|
zllu=min(abs(zmax),abs(zmin)) |
69 |
|
|
if(im.ge.100)WRITE(*,'(104x,900i1)')(mod(i/100,10),i=100,im) |
70 |
|
|
WRITE(*,'(14x,1000i1)')(mod(i/10,10),i=10,im) |
71 |
|
|
WRITE(*,'(5x,1009i1)')(mod(i,10),i=1,im) |
72 |
|
|
write(*,F1000) |
73 |
|
|
zinf=.false. |
74 |
|
|
znan=.false. |
75 |
|
|
DO 10017 j=1,jm |
76 |
|
|
DO 10019 i=1,im |
77 |
|
|
az=abs(z(i,j)) |
78 |
|
|
IF(.NOT.( az.eq.0.))GOTO 10021 |
79 |
|
|
kchar(i)=16 |
80 |
|
|
GOTO 10022 |
81 |
|
|
10021 IF(.NOT.((az.ne.0.and.icheck(1).eq.0.and.icheck(2).eq.2146435072)) |
82 |
|
|
*)GOTO 10023 |
83 |
|
|
kchar(i)=31 |
84 |
|
|
zinf=.true. |
85 |
|
|
GOTO 10022 |
86 |
|
|
10023 IF(.NOT.((az.ne.0.and.icheck(1).eq.0.and.icheck(2).eq.2146959360)) |
87 |
|
|
*)GOTO 10024 |
88 |
|
|
kchar(i)=32 |
89 |
|
|
znan=.true. |
90 |
|
|
GOTO 10022 |
91 |
|
|
10024 IF(.NOT.( zsign))GOTO 10025 |
92 |
|
|
kchar(i)=NINT(13.*(az-zllu)/(zllm-zllu)+17) |
93 |
|
|
GOTO 10026 |
94 |
|
|
10025 kchar(i)=NINT(13.*az/zllm+17) |
95 |
|
|
10026 CONTINUE |
96 |
|
|
10022 IF(.NOT.( z(i,j).lt.0.))GOTO 10027 |
97 |
|
|
kchar(i)=32-kchar(i) |
98 |
|
|
10027 CONTINUE |
99 |
|
|
10019 CONTINUE |
100 |
|
|
10020 WRITE(*,'(1x,i3,''|'',1000a)')j+1,(iform(kchar(i)),i=1,im),'|','| |
101 |
|
|
*' |
102 |
|
|
10017 CONTINUE |
103 |
|
|
10018 write(*,F1000) |
104 |
|
|
WRITE(*,'(5x,1000i1)')(mod(i,10),i=1,im) |
105 |
|
|
WRITE(*,'(14x,1000i1)')(mod(i/10,10),i=10,im) |
106 |
|
|
if(im.ge.100)WRITE(*,'(104x,900i1)')(mod(i/100,10),i=100,im) |
107 |
|
|
GOTO 10016 |
108 |
|
|
10015 print*,'>>> ZERO MAP <<<' |
109 |
|
|
10016 if(zinf)print*,' *** Infty value(s) (+ or -) in map ***' |
110 |
|
|
if(znan)print*,' *** NaN value(s) (?) in map ***' |
111 |
|
|
print* |
112 |
|
|
RETURN |
113 |
|
|
END |