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

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

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