[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 |
---|
| 6 | MODULE PROCEDURE dump_iarray, dump_rarray |
---|
| 7 | END INTERFACE |
---|
| 8 | |
---|
| 9 | PUBLIC dump_array |
---|
| 10 | |
---|
| 11 | CONTAINS |
---|
| 12 | |
---|
[3837] | 13 | SUBROUTINE dump_rarray(count, name, field1, field2, withHalos, & |
---|
[4403] | 14 | toGlobal, atStep) |
---|
[3432] | 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 |
---|
[3837] | 21 | LOGICAL, INTENT(in), OPTIONAL :: toGlobal |
---|
[4403] | 22 | INTEGER, INTENT(in), OPTIONAL :: atStep |
---|
[3432] | 23 | ! Locals |
---|
| 24 | INTEGER :: ji, jj |
---|
| 25 | CHARACTER (len=4) :: crank,ccount |
---|
[3837] | 26 | LOGICAL :: lwithHalos, ltoGlobal |
---|
[3432] | 27 | INTEGER :: ibound, jbound |
---|
| 28 | INTEGER, DIMENSION(2) :: shape1, shape2 |
---|
| 29 | CHARACTER (LEN=13), PARAMETER :: fmt_var = "(2I4,2E18.10)" |
---|
| 30 | |
---|
[4403] | 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 | |
---|
[3432] | 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 |
---|
[3837] | 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 |
---|
[3432] | 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 |
---|
[3837] | 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 |
---|
[3432] | 78 | END DO |
---|
[3837] | 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 |
---|
[3432] | 86 | END IF |
---|
| 87 | |
---|
| 88 | ELSE |
---|
| 89 | |
---|
| 90 | ibound = UBOUND(field1, 1) |
---|
| 91 | jbound = UBOUND(field1, 2) |
---|
| 92 | |
---|
| 93 | IF(PRESENT(field2))THEN |
---|
[3837] | 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,*) |
---|
[3432] | 101 | END DO |
---|
[3837] | 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 |
---|
[3432] | 110 | ELSE |
---|
[3837] | 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,*) |
---|
[3432] | 117 | END DO |
---|
[3837] | 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 |
---|
[3432] | 126 | END IF |
---|
| 127 | |
---|
| 128 | END IF |
---|
| 129 | |
---|
| 130 | CLOSE(997) |
---|
| 131 | |
---|
| 132 | END SUBROUTINE dump_rarray |
---|
| 133 | |
---|
| 134 | |
---|
[3837] | 135 | SUBROUTINE dump_iarray(count, name, field1, field2, withHalos, & |
---|
[4403] | 136 | toGlobal, atStep) |
---|
[3432] | 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 |
---|
[3837] | 143 | LOGICAL, INTENT(in), OPTIONAL :: toGlobal |
---|
[4403] | 144 | INTEGER, INTENT(in), OPTIONAL :: atStep |
---|
[3432] | 145 | ! Locals |
---|
| 146 | INTEGER :: ji, jj |
---|
| 147 | CHARACTER (len=4) :: crank,ccount |
---|
[3837] | 148 | LOGICAL :: lwithHalos, ltoGlobal |
---|
[3432] | 149 | INTEGER :: ibound, jbound |
---|
| 150 | INTEGER, DIMENSION(2) :: shape1, shape2 |
---|
| 151 | CHARACTER (LEN=13), PARAMETER :: fmt_var = "(2I4,(I6))" |
---|
| 152 | |
---|
[4403] | 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 | |
---|
[3432] | 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 |
---|
[3837] | 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 |
---|
[3432] | 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 |
---|
[3837] | 209 | WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), & |
---|
[3432] | 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 |
---|
[3837] | 217 | WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), field1(ji,jj) |
---|
[3432] | 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 | |
---|
| 229 | END MODULE arpdebugging |
---|