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.
arpdebugging.f90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/arpdebugging.f90 @ 3432

Last change on this file since 3432 was 3432, checked in by trackstand2, 12 years ago

Merge branch 'ksection_partition'
File size: 5.6 KB
Line 
1MODULE arpdebugging
2   USE dom_oce, Only: nldi, nlei, nldj, nlej, nimpp, njmpp, mig, mjg, narea
3   IMPLICIT none
4
5   INTERFACE dump_array
6      MODULE PROCEDURE dump_iarray, dump_rarray
7   END INTERFACE
8
9   PUBLIC dump_array
10
11  CONTAINS
12
13    SUBROUTINE dump_rarray(count, name, field1, field2, withHalos)
14      IMPLICIT none
15      INTEGER,           INTENT(in) :: count  ! What timestep we're on
16      CHARACTER (LEN=*), INTENT(in) :: name   ! Root of filename to create
17      REAL,              INTENT(in), DIMENSION(:,:)           :: field1
18      REAL,              INTENT(in), DIMENSION(:,:), OPTIONAL :: field2
19      LOGICAL,           INTENT(in),                 OPTIONAL :: withHalos
20      ! Locals
21      INTEGER           :: ji, jj
22      CHARACTER (len=4) :: crank,ccount
23      LOGICAL           :: lwithHalos
24      INTEGER           :: ibound, jbound
25      INTEGER, DIMENSION(2) :: shape1, shape2
26      CHARACTER (LEN=13), PARAMETER :: fmt_var = "(2I4,2E18.10)"
27
28      IF(PRESENT(field2))THEN
29         shape1= SHAPE(field1)
30         shape2 = SHAPE(field2)
31         IF( ANY(MASK=shape1.ne.shape2) )THEN
32            WRITE (*,*) 'dump_rarray: ERROR: SHAPEs of field1 and field2 do not match - not dumping arrays'
33            RETURN
34         END IF
35      END IF
36
37      lwithHalos = .false.
38      IF(present(withHalos))lwithHalos = withHalos
39
40      WRITE(crank,FMT="(I4)") narea-1
41      WRITE(ccount,FMT="(I4)") count
42      OPEN(UNIT=997, FILE=TRIM(ADJUSTL(name))//"_step_"//TRIM(ADJUSTL(ccount))//"_pe_"//TRIM(ADJUSTL(crank))//".dat", &
43           STATUS='REPLACE', ACTION='WRITE', IOSTAT=ji)
44      IF(ji.ne.0)THEN
45         WRITE (*,*) "ARPDBG - FAILED to open "//name//" dump file on "//crank//", call number "//ccount
46         RETURN
47      END IF
48
49      IF(.not. lwithHalos)THEN
50
51         IF(PRESENT(field2))THEN
52            DO jj=nldj,nlej,1
53               DO ji=nldi,nlei,1
54                  WRITE(997,FMT=fmt_var) mig(ji),mjg(jj), &
55                                                field1(ji,jj),field2(ji,jj)
56               END DO
57            END DO
58         ELSE
59            DO jj=nldj,nlej,1
60               DO ji=nldi,nlei,1
61                  WRITE(997,FMT=fmt_var) mig(ji),mjg(jj), &
62                                               field1(ji,jj)
63               END DO
64            END DO
65         END IF
66
67      ELSE
68
69         ibound = UBOUND(field1, 1)
70         jbound = UBOUND(field1, 2)
71
72         IF(PRESENT(field2))THEN
73            DO ji=1,ibound,1
74               DO jj=1,jbound,1
75                  WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), &
76                                                field1(ji,jj),field2(ji,jj)
77               END DO
78               WRITE(997,*)
79            END DO
80         ELSE
81            DO ji=1,ibound,1
82               DO jj=1,jbound,1
83                  WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), field1(ji,jj)
84               END DO
85               WRITE(997,*)
86            END DO
87         END IF
88
89      END IF
90
91      CLOSE(997)
92
93    END SUBROUTINE dump_rarray
94
95
96    SUBROUTINE dump_iarray(count, name, field1, field2, withHalos)
97      IMPLICIT none
98      INTEGER,           INTENT(in) :: count  ! What timestep we're on
99      CHARACTER (LEN=*), INTENT(in) :: name   ! Root of filename to create
100      INTEGER,           INTENT(in), DIMENSION(:,:)           :: field1
101      INTEGER,           INTENT(in), DIMENSION(:,:), OPTIONAL :: field2
102      LOGICAL,           INTENT(in),                 OPTIONAL :: withHalos
103      ! Locals
104      INTEGER           :: ji, jj
105      CHARACTER (len=4) :: crank,ccount
106      LOGICAL           :: lwithHalos
107      INTEGER           :: ibound, jbound
108      INTEGER, DIMENSION(2) :: shape1, shape2
109      CHARACTER (LEN=13), PARAMETER :: fmt_var = "(2I4,(I6))"
110
111      IF(PRESENT(field2))THEN
112         shape1= SHAPE(field1)
113         shape2 = SHAPE(field2)
114         IF( ANY(MASK=shape1.ne.shape2) )THEN
115            WRITE (*,*) 'dump_iarray: ERROR: SHAPEs of field1 and field2 do not match - not dumping arrays'
116            RETURN
117         END IF
118      END IF
119
120      lwithHalos = .false.
121      IF(present(withHalos))lwithHalos = withHalos
122
123      WRITE(crank,FMT="(I4)") narea-1
124      WRITE(ccount,FMT="(I4)") count
125      OPEN(UNIT=997, FILE=TRIM(ADJUSTL(name))//"_step_"//TRIM(ADJUSTL(ccount))//"_pe_"//TRIM(ADJUSTL(crank))//".dat", &
126           STATUS='REPLACE', ACTION='WRITE', IOSTAT=ji)
127      IF(ji.ne.0)THEN
128         WRITE (*,*) "ARPDBG - FAILED to open "//name//" dump file on "//crank//", call number "//ccount
129         RETURN
130      END IF
131
132      IF(.not. lwithHalos)THEN
133
134         IF(PRESENT(field2))THEN
135            DO jj=nldj,nlej,1
136               DO ji=nldi,nlei,1
137                  WRITE(997,FMT=fmt_var) mig(ji),mjg(jj), &
138                                                field1(ji,jj),field2(ji,jj)
139               END DO
140            END DO
141         ELSE
142            DO jj=nldj,nlej,1
143               DO ji=nldi,nlei,1
144                  WRITE(997,FMT=fmt_var) mig(ji),mjg(jj), &
145                                               field1(ji,jj)
146               END DO
147            END DO
148         END IF
149
150      ELSE
151
152         ibound = UBOUND(field1, 1)
153         jbound = UBOUND(field1, 2)
154
155         IF(PRESENT(field2))THEN
156            DO ji=1,ibound,1
157               DO jj=1,jbound,1
158                  WRITE(997,FMT=fmt_var) ji, jj, &
159                                                field1(ji,jj),field2(ji,jj)
160               END DO
161               WRITE(997,*)
162            END DO
163         ELSE
164            DO ji=1,ibound,1
165               DO jj=1,jbound,1
166                  WRITE(997,FMT=fmt_var) ji, jj, field1(ji,jj)
167               END DO
168               WRITE(997,*)
169            END DO
170         END IF
171
172      END IF
173
174      CLOSE(997)
175
176    END SUBROUTINE dump_iarray
177
178END MODULE arpdebugging
Note: See TracBrowser for help on using the repository browser.