[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, & |
---|
| 14 | toGlobal) |
---|
[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 |
---|
[3432] | 22 | ! Locals |
---|
| 23 | INTEGER :: ji, jj |
---|
| 24 | CHARACTER (len=4) :: crank,ccount |
---|
[3837] | 25 | LOGICAL :: lwithHalos, ltoGlobal |
---|
[3432] | 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 |
---|
[3837] | 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 |
---|
[3432] | 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 |
---|
[3837] | 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 |
---|
[3432] | 72 | END DO |
---|
[3837] | 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 |
---|
[3432] | 80 | END IF |
---|
| 81 | |
---|
| 82 | ELSE |
---|
| 83 | |
---|
| 84 | ibound = UBOUND(field1, 1) |
---|
| 85 | jbound = UBOUND(field1, 2) |
---|
| 86 | |
---|
| 87 | IF(PRESENT(field2))THEN |
---|
[3837] | 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,*) |
---|
[3432] | 95 | END DO |
---|
[3837] | 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 |
---|
[3432] | 104 | ELSE |
---|
[3837] | 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,*) |
---|
[3432] | 111 | END DO |
---|
[3837] | 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 |
---|
[3432] | 120 | END IF |
---|
| 121 | |
---|
| 122 | END IF |
---|
| 123 | |
---|
| 124 | CLOSE(997) |
---|
| 125 | |
---|
| 126 | END SUBROUTINE dump_rarray |
---|
| 127 | |
---|
| 128 | |
---|
[3837] | 129 | SUBROUTINE dump_iarray(count, name, field1, field2, withHalos, & |
---|
| 130 | toGlobal) |
---|
[3432] | 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 |
---|
[3837] | 137 | LOGICAL, INTENT(in), OPTIONAL :: toGlobal |
---|
[3432] | 138 | ! Locals |
---|
| 139 | INTEGER :: ji, jj |
---|
| 140 | CHARACTER (len=4) :: crank,ccount |
---|
[3837] | 141 | LOGICAL :: lwithHalos, ltoGlobal |
---|
[3432] | 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 |
---|
[3837] | 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 |
---|
[3432] | 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 |
---|
[3837] | 197 | WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), & |
---|
[3432] | 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 |
---|
[3837] | 205 | WRITE(997,FMT=fmt_var) mig(ji), mjg(jj), field1(ji,jj) |
---|
[3432] | 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 | |
---|
| 217 | END MODULE arpdebugging |
---|