[3432] | 1 | MODULE arpdebugging |
---|
| 2 | USE dom_oce, Only: nldi, nlei, nldj, nlej, nimpp, njmpp, mig, mjg, narea |
---|
| 3 | IMPLICIT none |
---|
| 4 | |
---|
| 5 | INTERFACE dump_array |
---|
[4412] | 6 | MODULE PROCEDURE dump_iarray, dump_1diarray, dump_rarray, dump_1drarray |
---|
[3432] | 7 | END INTERFACE |
---|
| 8 | |
---|
| 9 | PUBLIC dump_array |
---|
| 10 | |
---|
| 11 | CONTAINS |
---|
| 12 | |
---|
[4412] | 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 | |
---|
[3837] | 76 | SUBROUTINE dump_rarray(count, name, field1, field2, withHalos, & |
---|
[4403] | 77 | toGlobal, atStep) |
---|
[3432] | 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 |
---|
[3837] | 84 | LOGICAL, INTENT(in), OPTIONAL :: toGlobal |
---|
[4403] | 85 | INTEGER, INTENT(in), OPTIONAL :: atStep |
---|
[3432] | 86 | ! Locals |
---|
| 87 | INTEGER :: ji, jj |
---|
| 88 | CHARACTER (len=4) :: crank,ccount |
---|
[3837] | 89 | LOGICAL :: lwithHalos, ltoGlobal |
---|
[3432] | 90 | INTEGER :: ibound, jbound |
---|
| 91 | INTEGER, DIMENSION(2) :: shape1, shape2 |
---|
| 92 | CHARACTER (LEN=13), PARAMETER :: fmt_var = "(2I4,2E18.10)" |
---|
| 93 | |
---|
[4403] | 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 | |
---|
[3432] | 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 |
---|
[3837] | 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 |
---|
[3432] | 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 |
---|
[3837] | 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 |
---|
[3432] | 141 | END DO |
---|
[3837] | 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 |
---|
[3432] | 149 | END IF |
---|
| 150 | |
---|
| 151 | ELSE |
---|
| 152 | |
---|
| 153 | ibound = UBOUND(field1, 1) |
---|
| 154 | jbound = UBOUND(field1, 2) |
---|
| 155 | |
---|
| 156 | IF(PRESENT(field2))THEN |
---|
[3837] | 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,*) |
---|
[3432] | 164 | END DO |
---|
[3837] | 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 |
---|
[3432] | 173 | ELSE |
---|
[3837] | 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,*) |
---|
[3432] | 180 | END DO |
---|
[3837] | 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 |
---|
[3432] | 189 | END IF |
---|
| 190 | |
---|
| 191 | END IF |
---|
| 192 | |
---|
| 193 | CLOSE(997) |
---|
| 194 | |
---|
| 195 | END SUBROUTINE dump_rarray |
---|
| 196 | |
---|
| 197 | |
---|
[3837] | 198 | SUBROUTINE dump_iarray(count, name, field1, field2, withHalos, & |
---|
[4403] | 199 | toGlobal, atStep) |
---|
[3432] | 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 |
---|
[3837] | 206 | LOGICAL, INTENT(in), OPTIONAL :: toGlobal |
---|
[4403] | 207 | INTEGER, INTENT(in), OPTIONAL :: atStep |
---|
[3432] | 208 | ! Locals |
---|
| 209 | INTEGER :: ji, jj |
---|
| 210 | CHARACTER (len=4) :: crank,ccount |
---|
[3837] | 211 | LOGICAL :: lwithHalos, ltoGlobal |
---|
[3432] | 212 | INTEGER :: ibound, jbound |
---|
| 213 | INTEGER, DIMENSION(2) :: shape1, shape2 |
---|
| 214 | CHARACTER (LEN=13), PARAMETER :: fmt_var = "(2I4,(I6))" |
---|
| 215 | |
---|
[4403] | 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 | |
---|
[3432] | 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 |
---|
[3837] | 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 |
---|
[3432] | 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 |
---|
[3837] | 272 | WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), & |
---|
[3432] | 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 |
---|
[3837] | 280 | WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), field1(ji,jj) |
---|
[3432] | 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 | |
---|
| 292 | END MODULE arpdebugging |
---|