| [5133] | 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 ================================================================== |
|---|
| [5185] | 10 | c Comme dump2d sauf que le signe est pr�serv�, la valeur zero |
|---|
| [5133] | 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 |
|---|
| [5185] | 81 | 10021 IF(.NOT.((az.ne.0.AND.icheck(1).eq.0.AND.icheck(2).eq.2146435072)) |
|---|
| [5133] | 82 | *)GOTO 10023 |
|---|
| 83 | kchar(i)=31 |
|---|
| 84 | zinf=.true. |
|---|
| 85 | GOTO 10022 |
|---|
| [5185] | 86 | 10023 IF(.NOT.((az.ne.0.AND.icheck(1).eq.0.AND.icheck(2).eq.2146959360)) |
|---|
| [5133] | 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 |
|---|
