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 @ 4412

Last change on this file since 4412 was 4412, checked in by trackstand2, 10 years ago

Added dump_1drarray()

File size: 9.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_1diarray, dump_rarray, dump_1drarray
7   END INTERFACE
8
9   PUBLIC dump_array
10
11  CONTAINS
12
13    SUBROUTINE dump_1drarray(count, name, field1)
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      ! Locals
19      INTEGER           :: ji
20      CHARACTER (len=4) :: crank,ccount
21      INTEGER           :: ibound
22      CHARACTER (LEN=13), PARAMETER :: fmt_var = "(I4,E18.10)"
23
24      WRITE(crank,FMT="(I4)") narea-1
25      WRITE(ccount,FMT="(I4)") count
26      OPEN(UNIT=997, FILE=TRIM(ADJUSTL(name))//"_step_"//TRIM(ADJUSTL(ccount))//"_pe_"//TRIM(ADJUSTL(crank))//".dat", &
27           STATUS='REPLACE', ACTION='WRITE', IOSTAT=ji)
28      IF(ji.ne.0)THEN
29         WRITE (*,*) "ARPDBG - FAILED to open "//name//" dump file on "//crank//", call number "//ccount
30         RETURN
31      END IF
32
33      ibound = UBOUND(field1, 1)
34
35      DO ji=1,ibound,1
36         WRITE(997,FMT=fmt_var) ji, field1(ji)
37      END DO
38      WRITE(997,*)
39
40      CLOSE(997)
41
42    END SUBROUTINE dump_1drarray
43
44
45    SUBROUTINE dump_1diarray(count, name, field1)
46      IMPLICIT none
47      INTEGER,           INTENT(in) :: count  ! What timestep we're on
48      CHARACTER (LEN=*), INTENT(in) :: name   ! Root of filename to create
49      INTEGER,           INTENT(in), DIMENSION(:) :: field1
50      ! Locals
51      INTEGER           :: ji
52      CHARACTER (len=4) :: crank,ccount
53      INTEGER           :: ibound
54      CHARACTER (LEN=13), PARAMETER :: fmt_var = "(I4,1X,I6)"
55
56      WRITE(crank,FMT="(I4)") narea-1
57      WRITE(ccount,FMT="(I4)") count
58      OPEN(UNIT=997, FILE=TRIM(ADJUSTL(name))//"_step_"//TRIM(ADJUSTL(ccount))//"_pe_"//TRIM(ADJUSTL(crank))//".dat", &
59           STATUS='REPLACE', ACTION='WRITE', IOSTAT=ji)
60      IF(ji.ne.0)THEN
61         WRITE (*,*) "ARPDBG - FAILED to open "//name//" dump file on "//crank//", call number "//ccount
62         RETURN
63      END IF
64
65      ibound = UBOUND(field1, 1)
66
67      DO ji=1,ibound,1
68         WRITE(997,FMT=fmt_var) ji, field1(ji)
69      END DO
70      WRITE(997,*)
71
72      CLOSE(997)
73
74    END SUBROUTINE dump_1diarray
75
76    SUBROUTINE dump_rarray(count, name, field1, field2, withHalos, &
77                           toGlobal, atStep)
78      IMPLICIT none
79      INTEGER,           INTENT(in) :: count  ! What timestep we're on
80      CHARACTER (LEN=*), INTENT(in) :: name   ! Root of filename to create
81      REAL,              INTENT(in), DIMENSION(:,:)           :: field1
82      REAL,              INTENT(in), DIMENSION(:,:), OPTIONAL :: field2
83      LOGICAL,           INTENT(in),                 OPTIONAL :: withHalos
84      LOGICAL,           INTENT(in),                 OPTIONAL :: toGlobal
85      INTEGER,           INTENT(in),                 OPTIONAL :: atStep
86      ! Locals
87      INTEGER           :: ji, jj
88      CHARACTER (len=4) :: crank,ccount
89      LOGICAL           :: lwithHalos, ltoGlobal
90      INTEGER           :: ibound, jbound
91      INTEGER, DIMENSION(2) :: shape1, shape2
92      CHARACTER (LEN=13), PARAMETER :: fmt_var = "(2I4,2E18.10)"
93
94      IF(PRESENT(atStep))THEN
95         ! If this isn't the desired time-step to dump then don't
96         IF(count /= atStep)RETURN
97      END IF
98
99      IF(PRESENT(field2))THEN
100         shape1= SHAPE(field1)
101         shape2 = SHAPE(field2)
102         IF( ANY(MASK=shape1.ne.shape2) )THEN
103            WRITE (*,*) 'dump_rarray: ERROR: SHAPEs of field1 and field2 do not match - not dumping arrays'
104            RETURN
105         END IF
106      END IF
107
108      lwithHalos = .false.
109      IF(present(withHalos))lwithHalos = withHalos
110      ! By default we convert to global coordinates rather than those local
111      ! to this process
112      ltoGlobal = .true.
113      IF(present(toGlobal))ltoGlobal = toGlobal
114
115      WRITE(crank,FMT="(I4)") narea-1
116      WRITE(ccount,FMT="(I4)") count
117      OPEN(UNIT=997, FILE=TRIM(ADJUSTL(name))//"_step_"//TRIM(ADJUSTL(ccount))//"_pe_"//TRIM(ADJUSTL(crank))//".dat", &
118           STATUS='REPLACE', ACTION='WRITE', IOSTAT=ji)
119      IF(ji.ne.0)THEN
120         WRITE (*,*) "ARPDBG - FAILED to open "//name//" dump file on "//crank//", call number "//ccount
121         RETURN
122      END IF
123
124      IF(.not. lwithHalos)THEN
125
126         IF(PRESENT(field2))THEN
127            DO jj=nldj,nlej,1
128               DO ji=nldi,nlei,1
129                  WRITE(997,FMT=fmt_var) mig(ji),mjg(jj), &
130                                                field1(ji,jj),field2(ji,jj)
131               END DO
132            END DO
133         ELSE
134
135            IF(ltoGlobal)THEN
136               DO jj=nldj,nlej,1
137                  DO ji=nldi,nlei,1
138                     WRITE(997,FMT=fmt_var) mig(ji),mjg(jj), &
139                                            field1(ji,jj)
140                  END DO
141               END DO
142            ELSE
143               DO jj=nldj,nlej,1
144                  DO ji=nldi,nlei,1
145                     WRITE(997,FMT=fmt_var) ji,jj, field1(ji,jj)
146                  END DO
147               END DO
148            END IF
149         END IF
150
151      ELSE
152
153         ibound = UBOUND(field1, 1)
154         jbound = UBOUND(field1, 2)
155
156         IF(PRESENT(field2))THEN
157            IF(ltoGlobal)THEN
158               DO ji=1,ibound,1
159                  DO jj=1,jbound,1
160                     WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), &
161                                            field1(ji,jj),field2(ji,jj)
162                  END DO
163                  WRITE(997,*)
164               END DO
165            ELSE
166               DO ji=1,ibound,1
167                  DO jj=1,jbound,1
168                     WRITE(997,FMT=fmt_var) ji, jj, field1(ji,jj), field2(ji,jj)
169                  END DO
170                  WRITE(997,*)
171               END DO
172            END IF
173         ELSE
174            IF(ltoGlobal)THEN
175               DO ji=1,ibound,1
176                  DO jj=1,jbound,1
177                     WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), field1(ji,jj)
178                  END DO
179                  WRITE(997,*)
180               END DO
181            ELSE
182               DO ji=1,ibound,1
183                  DO jj=1,jbound,1
184                     WRITE(997,FMT=fmt_var) ji, jj, field1(ji,jj)
185                  END DO
186                  WRITE(997,*)
187               END DO
188            END IF
189         END IF
190
191      END IF
192
193      CLOSE(997)
194
195    END SUBROUTINE dump_rarray
196
197
198    SUBROUTINE dump_iarray(count, name, field1, field2, withHalos, &
199                           toGlobal, atStep)
200      IMPLICIT none
201      INTEGER,           INTENT(in) :: count  ! What timestep we're on
202      CHARACTER (LEN=*), INTENT(in) :: name   ! Root of filename to create
203      INTEGER,           INTENT(in), DIMENSION(:,:)           :: field1
204      INTEGER,           INTENT(in), DIMENSION(:,:), OPTIONAL :: field2
205      LOGICAL,           INTENT(in),                 OPTIONAL :: withHalos
206      LOGICAL,           INTENT(in),                 OPTIONAL :: toGlobal
207      INTEGER,           INTENT(in),                 OPTIONAL :: atStep
208      ! Locals
209      INTEGER           :: ji, jj
210      CHARACTER (len=4) :: crank,ccount
211      LOGICAL           :: lwithHalos, ltoGlobal
212      INTEGER           :: ibound, jbound
213      INTEGER, DIMENSION(2) :: shape1, shape2
214      CHARACTER (LEN=13), PARAMETER :: fmt_var = "(2I4,(I6))"
215
216      IF(PRESENT(atStep))THEN
217         ! If this isn't the desired time-step to dump then don't
218         IF(count /= atStep)RETURN
219      END IF
220
221      IF(PRESENT(field2))THEN
222         shape1= SHAPE(field1)
223         shape2 = SHAPE(field2)
224         IF( ANY(MASK=shape1.ne.shape2) )THEN
225            WRITE (*,*) 'dump_iarray: ERROR: SHAPEs of field1 and field2 do not match - not dumping arrays'
226            RETURN
227         END IF
228      END IF
229
230      lwithHalos = .false.
231      IF(present(withHalos))lwithHalos = withHalos
232      ! By default we convert to global coordinates rather than those local
233      ! to this process
234      ltoGlobal = .true.
235      IF(present(toGlobal))ltoGlobal = toGlobal
236
237      WRITE(crank,FMT="(I4)") narea-1
238      WRITE(ccount,FMT="(I4)") count
239      OPEN(UNIT=997, FILE=TRIM(ADJUSTL(name))//"_step_"//TRIM(ADJUSTL(ccount))//"_pe_"//TRIM(ADJUSTL(crank))//".dat", &
240           STATUS='REPLACE', ACTION='WRITE', IOSTAT=ji)
241      IF(ji.ne.0)THEN
242         WRITE (*,*) "ARPDBG - FAILED to open "//name//" dump file on "//crank//", call number "//ccount
243         RETURN
244      END IF
245
246      IF(.not. lwithHalos)THEN
247
248         IF(PRESENT(field2))THEN
249            DO jj=nldj,nlej,1
250               DO ji=nldi,nlei,1
251                  WRITE(997,FMT=fmt_var) mig(ji),mjg(jj), &
252                                                field1(ji,jj),field2(ji,jj)
253               END DO
254            END DO
255         ELSE
256            DO jj=nldj,nlej,1
257               DO ji=nldi,nlei,1
258                  WRITE(997,FMT=fmt_var) mig(ji),mjg(jj), &
259                                               field1(ji,jj)
260               END DO
261            END DO
262         END IF
263
264      ELSE
265
266         ibound = UBOUND(field1, 1)
267         jbound = UBOUND(field1, 2)
268
269         IF(PRESENT(field2))THEN
270            DO ji=1,ibound,1
271               DO jj=1,jbound,1
272                  WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), &
273                                                field1(ji,jj),field2(ji,jj)
274               END DO
275               WRITE(997,*)
276            END DO
277         ELSE
278            DO ji=1,ibound,1
279               DO jj=1,jbound,1
280                  WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), field1(ji,jj)
281               END DO
282               WRITE(997,*)
283            END DO
284         END IF
285
286      END IF
287
288      CLOSE(997)
289
290    END SUBROUTINE dump_iarray
291
292END MODULE arpdebugging
Note: See TracBrowser for help on using the repository browser.