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

Last change on this file since 3837 was 3837, checked in by trackstand2, 11 years ago

Merge of finiss

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