New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
lib_print.f90 in tags/nemo_dev_x3/NEMO/OPA_SRC – NEMO

source: tags/nemo_dev_x3/NEMO/OPA_SRC/lib_print.f90 @ 105

Last change on this file since 105 was 105, checked in by cvs2svn, 20 years ago

This commit was manufactured by cvs2svn to create tag 'nemo_dev_x3'.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.2 KB
Line 
1MODULE lib_print
2   !!======================================================================
3   !!                    ***  MODULE  lib_print  ***
4   !! print librairy :  formated real and integer array print
5   !!=====================================================================
6     
7   !!----------------------------------------------------------------------
8   !!   prihin       : print an integer 2D horizontal field
9   !!   prihre       : print an real 2D horizontal field
10   !!   prizre       : print an real 2D vertical field
11   !!----------------------------------------------------------------------
12   !! * Mules used
13   USE par_kind      ! kind parameters
14
15   IMPLICIT NONE
16   PRIVATE
17
18   !! * Routine accessibility
19   PUBLIC prihin, prihre, prizre
20   !!----------------------------------------------------------------------
21
22CONTAINS
23
24   SUBROUTINE prihin( ktab, ki   , kj   , kideb, kifin ,   &
25                      kind, kjdeb, kjfin, kjnd , kscale, kumout )
26      !!----------------------------------------------------------------------
27      !!                   ***  SUBROUTINE  prihre  ***
28      !! 
29      !! ** purpose :   Print an integer field
30      !!
31      !! ** method :   format of print is selected with the dummy argument kscale
32      !!
33      !! History :
34      !!        !  90-04 (0. Marti)  Original code
35      !!        !  92-02 (M. Imbard)
36      !!        !  03-07 (G. Madec)  F90, free form
37      !!----------------------------------------------------------------------
38      !! * Arguments
39      INTEGER, INTENT( in ) ::   &
40         ki, kj,                 &  ! array dimensions
41         kideb, kifin, kind,     &  ! first and last index, increment for i
42         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
43         kscale,                 &  ! kscale=0 or > 5  print ktab with format i8
44      !                             !         kscale=1 print ktab with format i1
45      !                             !         kscale=2 print ktab with format i2
46      !                             !         kscale=3 print ktab with format i3
47      !                             !         kscale=4 print ktab with format i4
48      !                             !         kscale=5 print ktab with format i5
49         kumout                     ! unit in which print
50      INTEGER, DIMENSION(ki,kj), INTENT( in ) ::   &
51         ktab                       ! integer 2D array to be print
52
53      !! * local declarations
54      INTEGER ::   ji, jj, jn       ! dummy loop indices
55      INTEGER ::   isca, il1, il2   ! temporary integers
56      INTEGER ::   iind, ijnd       ! temporary integers
57      !!----------------------------------------------------------------------
58      !!  OPA 9.0, LODYC (2003)
59      !!----------------------------------------------------------------------
60
61      isca = 10
62      IF( kscale == 0 )   isca = 10
63      IF( kscale == 1 )   isca = 100
64      IF( kscale == 2 )   isca = 60
65      IF( kscale == 3 )   isca = 40
66      IF( kscale == 4 )   isca = 30
67      IF( kscale == 5 )   isca = 20
68
69      iind = MAX( 1, kind )
70      ijnd = MAX( 1, kjnd )
71
72      il1 = kideb
73
74      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
75
76        IF( il1 > kifin ) RETURN
77        WRITE(kumout,'(/)')
78        il2 = il1+iind*(isca-1)
79        IF( il2 > kifin )   il2 = kifin
80
81        IF( kscale == 1 ) THEN
82            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)') il1, il2, iind
83            DO jj = kjfin, kjdeb, -ijnd
84              WRITE (kumout,'(1x,i3,100i1)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
85            END DO 
86        ELSEIF( kscale == 2 ) THEN
87            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
88            DO jj = kjfin, kjdeb, -ijnd
89              WRITE (kumout,'(1x,i3,60i2)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
90            END DO 
91        ELSEIF( kscale == 3 ) THEN
92            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
93            DO jj = kjfin, kjdeb, -ijnd
94              WRITE (kumout,'(1x,i3,40i3)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
95            END DO 
96        ELSEIF( kscale == 4 ) THEN
97            WRITE(kumout,'(4x,30i4,/)') ( ji, ji = il1, il2, iind )
98            DO jj = kjfin, kjdeb, -ijnd
99              WRITE (kumout,'(1x,i3,30i4)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
100            END DO 
101        ELSEIF( kscale == 5 ) THEN
102            WRITE(kumout,'(4x,20i5,/)') ( ji, ji = il1, il2, iind )
103            DO jj = kjfin, kjdeb, -ijnd
104              WRITE (kumout,'(1x,i3,20i5)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
105            END DO 
106        ELSE
107            WRITE(kumout,'(4x,10i8,/)') ( ji, ji = il1, il2, iind )
108            DO jj = kjfin, kjdeb, -ijnd
109              WRITE (kumout,'(1x,i3,10i8)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
110            END DO 
111        ENDIF
112
113        il1 = il1 + iind * isca
114      END DO 
115
116   END SUBROUTINE prihin
117
118
119   SUBROUTINE prihre( ptab, ki   , kj   , kideb, kifin ,   &
120                      kind, kjdeb, kjfin, kjnd , pscale, kumout )
121      !!----------------------------------------------------------------------
122      !!                  ***  ROUTINE prihre  ***
123      !!     
124      !! ** purpose :   Print a real field with the format 10e12.4 or 20f6.2
125      !!
126      !! ** method  :   the print format is selected with the pscale argument
127      !!
128      !! History :
129      !!   1.0  !  86-01  (P. Andrich)  Original code
130      !!        !  89-11  (C. Levy)
131      !!        !  92-02  (M. Imbard)
132      !!        !  92-06  (M. Imbard)
133      !!----------------------------------------------------------------------
134      !! * Arguments
135      INTEGER, INTENT( in ) ::   &
136         ki, kj,                 &  ! array dimensions
137         kideb, kifin, kind,     &  ! first and last index, increment for i
138         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
139         kumout                     ! unit in which print
140      REAL(wp), INTENT( in ) ::   &
141         pscale                     ! = 0  print        ptab with e13.5 format
142         !                          ! else print pscale*ptab with f6.2 format
143      REAL(wp), DIMENSION(ki,kj), INTENT( in ) ::   &
144         ptab                       ! integer 2D array to be print
145
146      !! * Local variables
147      INTEGER ::   ji, jj, jn       ! dummy loop indices
148      INTEGER ::   isca, il1, il2   ! temporary integers
149      !!----------------------------------------------------------------------
150      !!  OPA 9.0, LODYC-IPSL (2003)
151      !!----------------------------------------------------------------------
152
153      isca = 10
154      IF( pscale /= 0. )   isca=20
155
156      il1 = kideb
157
158      DO jn = 1, (kifin-kideb+1)/(kind*isca) + 1
159
160        IF( il1 > kifin )   RETURN
161
162        WRITE(kumout,9100)
163
164        il2 = il1+kind*(isca-1)
165        IF(il2 > kifin) il2 = kifin
166        IF( pscale == 0.) THEN
167            WRITE(kumout,9101) ( ji, ji = il1, il2, kind )
168            DO jj = kjfin, kjdeb, -kjnd
169              WRITE(kumout,9102) jj, ( ptab(ji,jj), ji = il1, il2, kind )
170            END DO 
171        ELSE
172            WRITE(kumout,9103) ( ji, ji = il1, il2, kind )
173            DO jj = kjfin, kjdeb, -kjnd
174              WRITE(kumout,9104) jj, ( pscale*ptab(ji,jj), ji = il1, il2, kind )
175            END DO 
176        ENDIF
177        il1 = il1+kind*isca
178
179      END DO 
180
181      ! formats
182 9100 FORMAT(/)
183 9101 FORMAT(10i12, /)
184 9102 FORMAT(1x, i3, 10(1pe12.4))
185 9103 FORMAT(3x, 20i6, /)
186 9104 FORMAT(1x, i3, 1x, 20f6.2)
187
188   END SUBROUTINE prihre
189
190
191   SUBROUTINE prizre( ptab , ki   , kj   , kk   , kjcut ,   &
192                      kideb, kifin, kid  , kkdeb, kkfin ,   &
193                      kkd  , pscale, kumout )
194      !!----------------------------------------------------------------------
195      !!                      ***  ROUTINE prizre  ***
196      !!
197      !! ** purpose :   Print a vertical slab from a tridimentional real field
198      !!
199      !!   METHOD :
200      !! ** method  :   the print format is selected with the argument pscale
201      !!
202      !! History :
203      !!      original : 86-01 (o. Marti)
204      !!      addition : 92-02 (M. Imbard)
205      !!      addition : 92-06 (M. Imbard)
206      !!----------------------------------------------------------------------
207      !! * Arguments
208      INTEGER, INTENT( in ) ::   &
209         ki, kj, kk,             &  ! array dimensions
210         kjcut,                  &  ! index j for the vertical slab
211         kideb, kifin, kid,      &  ! first and last index, increment for i
212         kkdeb, kkfin, kkd,      &  ! first and last index, increment for k
213         kumout                     ! unit in which print
214      REAL(wp), INTENT( in ) ::   &
215         pscale                     ! = 0  print        ptab with e12.4 format
216         !                          ! else print pscale*ptab with f6.2 format
217      REAL(wp), DIMENSION(ki,kj,kk), INTENT( in ) ::   &
218         ptab                       ! integer 3D array to be print
219
220      !! * Local variables
221      INTEGER ::   ji, jn, jk       ! dummy loop indices
222      INTEGER ::   isca, il1, il2   ! temporary integers
223      INTEGER ::   iind, iknd       !    "          "
224      !!----------------------------------------------------------------------
225      !!  OPA8, LODYC (15/11/96)
226      !!----------------------------------------------------------------------
227
228
229      iind = kid
230      iknd = kkd
231      isca = 10
232      IF( pscale /= 0.) isca = 20
233
234      IF (iind == 0) iind = 1
235      IF (iknd == 0) iknd = 1
236
237      il1 = kideb
238
239      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
240
241        IF(il1 > kifin) RETURN
242        WRITE(kumout,9100)
243        il2 = il1+iind*(isca-1)
244        IF(il2 > kifin) il2 = kifin
245
246        IF( pscale == 0.) THEN
247            WRITE(kumout,9101) ( ji, ji = il1, il2, iind )
248            DO jk = kkdeb, kkfin, iknd
249              WRITE (kumout,9102) jk, ( ptab(ji,kjcut,jk), ji = il1, il2, iind )
250            END DO 
251        ELSE
252            WRITE (kumout,9103) ( ji, ji = il1, il2, iind )
253            DO jk = kkdeb, kkfin, iknd
254              WRITE(kumout,9104)jk, ( pscale*ptab(ji,kjcut,jk), ji = il1, il2, iind )
255            END DO 
256        ENDIF
257
258        il1 = il1+iind*isca
259      END DO     
260
261 9100 FORMAT(/)
262 9101 FORMAT(10i12, /)
263 9102 FORMAT(1x, i3, 10(1pe12.4))
264 9103 FORMAT(3x, 20i6, /)
265 9104 FORMAT(1x, i3, 1x, 20f6.1)
266
267      END SUBROUTINE prizre
268
269   !!======================================================================
270END MODULE lib_print
Note: See TracBrowser for help on using the repository browser.