| Line |
Branch |
Exec |
Source |
| 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 |
| 114 |
|
|
|