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 branches/UKMO/dev_r10171_test_crs_AMM7/NEMOGCM/NEMO/OPA_SRC – NEMO

source: branches/UKMO/dev_r10171_test_crs_AMM7/NEMOGCM/NEMO/OPA_SRC/lib_print.f90 @ 10207

Last change on this file since 10207 was 10207, checked in by cmao, 5 years ago

remove svn keyword

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