source: LMDZ6/branches/LMDZ-COSP/libf/phylmd/rrtm/dump2ds.F @ 3847

Last change on this file since 3847 was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM


Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.7 KB
Line 
1      SUBROUTINE dump2ds(im,jm,z,nom_z)
2C Copyright (C) 2005 Centre National de la Recherche Scientifique
3c ==================================================================
4c Perform a scatter plot print of big matrices using regular
5c intervals between min and max matrix coefficient values.
6c ==================================================================
7c adapted from LMD3 by Alain Lahellec and retranscipted for LMDZ5
8c NAN et INF ajoute aux plots                           Pat fin 2006
9c ==================================================================
10c Comme dump2d sauf que le signe est préservé, la valeur zero
11c identifiee par un blanc.
12c detection des Infty (= ou -) et NaN (?)
13c ==================================================================
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)='.    '
3110001 CONTINUE
3210002 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
4510007 IF(.NOT.( z(i,j).LT.zmin))GOTO 10009
46      zmin=z(i,j)
47      imin=i
48      jmin=j
4910009 IF(.NOT.( z(i,j).eq.0.))GOTO 10011
50      kzero=kzero+1
5110011 CONTINUE
5210005 CONTINUE
5310006 CONTINUE
5410003 CONTINUE
5510004 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
6210013 PRINT2000,' [MIN:',zmin,'(',imin,',',jmin,') ( NOPQRSTUVWXYZ*+) ',
63     *zmax,'(',imax,',',jmax,'):MAX]'
6410014 CONTINUE
652000  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
8110021 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
8610023 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
9110024 IF(.NOT.( zsign))GOTO 10025
92      kchar(i)=NINT(13.*(az-zllu)/(zllm-zllu)+17)
93      GOTO 10026
9410025 kchar(i)=NINT(13.*az/zllm+17)
9510026 CONTINUE
9610022 IF(.NOT.( z(i,j).lt.0.))GOTO 10027
97      kchar(i)=32-kchar(i)
9810027 CONTINUE
9910019 CONTINUE
10010020 WRITE(*,'(1x,i3,''|'',1000a)')j+1,(iform(kchar(i)),i=1,im),'|','|
101     *'
10210017 CONTINUE
10310018 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
10810015 print*,'>>> ZERO MAP  <<<'
10910016 if(zinf)print*,' *** Infty value(s) (+ or -) in map ***'
110      if(znan)print*,' *** NaN value(s) (?) in map ***'
111      print*
112      RETURN
113      END
Note: See TracBrowser for help on using the repository browser.