[1765] | 1 | program max_diff_nc |
---|
| 2 | |
---|
| 3 | ! This is a program in Fortran 95. |
---|
| 4 | ! Author: Lionel GUEZ |
---|
| 5 | ! See description in wrapper script. |
---|
| 6 | |
---|
| 7 | ! Maximum memory used will normally be: |
---|
| 8 | |
---|
| 9 | ! -- without computation of average order of magnitude: about 5 |
---|
| 10 | ! times the memory occupied by the largest variable; |
---|
| 11 | |
---|
| 12 | ! -- with computation of average order of magnitude: about 7 times |
---|
| 13 | ! the memory occupied by the largest variable. |
---|
| 14 | |
---|
| 15 | ! This program is meant to be used with a wrapper script so input |
---|
| 16 | ! statements do not have prompts. |
---|
| 17 | |
---|
| 18 | use netcdf95, only: nf95_close, nf95_gw_var, nf95_inq_varid, nf95_inquire, & |
---|
| 19 | nf95_inquire_variable, nf95_open |
---|
| 20 | use netcdf, only: nf90_noerr, nf90_nowrite, nf90_max_name, NF90_FLOAT, & |
---|
| 21 | NF90_double |
---|
| 22 | use jumble, only: compare |
---|
| 23 | |
---|
| 24 | implicit none |
---|
| 25 | |
---|
| 26 | integer, parameter:: wp = kind(0d0) ! working precision |
---|
| 27 | |
---|
| 28 | integer ncid1, ncid2, ncerr, xtype1, ndims |
---|
| 29 | integer nvariables ! number of variables in the first file |
---|
| 30 | integer nvar_comp ! number of variables which will be compared |
---|
| 31 | integer, allocatable:: varid1(:), varid2(:) |
---|
| 32 | real(wp), pointer:: v1_1d(:), v2_1d(:) |
---|
| 33 | real(wp), pointer:: v1_2d(:, :), v2_2d(:, :) |
---|
| 34 | real(wp), pointer:: v1_3d(:, :, :), v2_3d(:, :, :) |
---|
| 35 | real(wp), pointer:: v1_4d(:, :, :, :), v2_4d(:, :, :, :) |
---|
| 36 | character(len=nf90_max_name) name1 |
---|
| 37 | logical same_varid ! compare variables with same varid |
---|
| 38 | logical report_id ! report identical variables |
---|
| 39 | logical comp_mag ! compute avergage order of magnitude |
---|
| 40 | logical quiet |
---|
| 41 | character(len=30+nf90_max_name), allocatable:: tag(:) |
---|
| 42 | integer i |
---|
| 43 | |
---|
| 44 | !---------------------- |
---|
| 45 | |
---|
| 46 | read *, same_varid |
---|
| 47 | read *, report_id |
---|
| 48 | read *, quiet |
---|
| 49 | read *, comp_mag |
---|
| 50 | read "(a)", name1 |
---|
| 51 | |
---|
| 52 | call nf95_open("in1.nc", nf90_nowrite, ncid1) |
---|
| 53 | call nf95_open("in2.nc", nf90_nowrite, ncid2) |
---|
| 54 | |
---|
| 55 | ! Define "nvar_comp", "varid1(:nvar_comp)", "varid2(:nvar_comp)" and |
---|
| 56 | ! "tag(:nvar_comp)": |
---|
| 57 | if (name1 == "") then |
---|
| 58 | ! We want to compare all the variables |
---|
| 59 | call nf95_inquire(ncid1, nvariables=nvariables) |
---|
| 60 | print *, "Found ", nvariables, " variable(s) in the first file." |
---|
| 61 | allocate(varid1(nvariables), varid2(nvariables), tag(nvariables)) |
---|
| 62 | if (same_varid) then |
---|
| 63 | nvar_comp = nvariables |
---|
| 64 | varid1 = (/(i, i = 1, nvariables)/) |
---|
| 65 | varid2 = varid1 |
---|
| 66 | do i = 1, nvariables |
---|
| 67 | call nf95_inquire_variable(ncid1, varid1(i), name1) |
---|
| 68 | tag(i) = 'Variable "' // trim(name1) // '" (name in the first file)' |
---|
| 69 | end do |
---|
| 70 | else |
---|
| 71 | nvar_comp = 0 |
---|
| 72 | do i = 1, nvariables |
---|
| 73 | call nf95_inquire_variable(ncid1, i, name1) |
---|
| 74 | call nf95_inq_varid(ncid2, trim(name1), varid2(nvar_comp + 1), & |
---|
| 75 | ncerr) |
---|
| 76 | if (ncerr == nf90_noerr) then |
---|
| 77 | varid1(nvar_comp + 1) = i |
---|
| 78 | tag(nvar_comp + 1) = 'Variable "' // trim(name1) // '"' |
---|
| 79 | nvar_comp = nvar_comp + 1 |
---|
| 80 | else |
---|
| 81 | print *, 'Could not find "' // trim(name1) & |
---|
| 82 | // '" in the second file. Comparison will be skipped.' |
---|
| 83 | end if |
---|
| 84 | end do |
---|
| 85 | end if |
---|
| 86 | else |
---|
| 87 | nvar_comp = 1 |
---|
| 88 | allocate(varid1(1), varid2(1), tag(1)) |
---|
| 89 | call nf95_inq_varid(ncid1, trim(name1), varid1(1)) |
---|
| 90 | call nf95_inq_varid(ncid2, trim(name1), varid2(1)) |
---|
| 91 | tag(1) = 'Variable "' // trim(name1) // '"' |
---|
| 92 | end if |
---|
| 93 | |
---|
| 94 | do i = 1, nvar_comp |
---|
| 95 | call nf95_inquire_variable(ncid1, varid1(i), xtype=xtype1, ndims=ndims) |
---|
| 96 | if (xtype1 == nf90_float .or. xtype1 == nf90_double) then |
---|
| 97 | select case (ndims) |
---|
| 98 | case (1) |
---|
| 99 | call nf95_gw_var(ncid1, varid1(i), v1_1d) |
---|
| 100 | call nf95_gw_var(ncid2, varid2(i), v2_1d) |
---|
| 101 | call compare(v1_1d, v2_1d, trim(tag(i)), comp_mag, report_id, quiet) |
---|
| 102 | deallocate(v1_1d, v2_1d) |
---|
| 103 | case (2) |
---|
| 104 | call nf95_gw_var(ncid1, varid1(i), v1_2d) |
---|
| 105 | call nf95_gw_var(ncid2, varid2(i), v2_2d) |
---|
| 106 | call compare(v1_2d, v2_2d, trim(tag(i)), comp_mag, report_id, quiet) |
---|
| 107 | deallocate(v1_2d, v2_2d) |
---|
| 108 | case (3) |
---|
| 109 | call nf95_gw_var(ncid1, varid1(i), v1_3d) |
---|
| 110 | call nf95_gw_var(ncid2, varid2(i), v2_3d) |
---|
| 111 | call compare(v1_3d, v2_3d, trim(tag(i)), comp_mag, report_id, quiet) |
---|
| 112 | deallocate(v1_3d, v2_3d) |
---|
| 113 | case (4) |
---|
| 114 | call nf95_gw_var(ncid1, varid1(i), v1_4d) |
---|
| 115 | call nf95_gw_var(ncid2, varid2(i), v2_4d) |
---|
| 116 | call compare(v1_4d, v2_4d, trim(tag(i)), comp_mag, report_id, quiet) |
---|
| 117 | deallocate(v1_4d, v2_4d) |
---|
| 118 | case default |
---|
| 119 | print * |
---|
| 120 | print *, "******************" |
---|
| 121 | print *, trim(tag(i)) // ":" |
---|
| 122 | print *, "Rank not supported." |
---|
| 123 | print *, "ndims = ", ndims |
---|
| 124 | end select |
---|
| 125 | else |
---|
| 126 | print * |
---|
| 127 | print *, "******************" |
---|
| 128 | print *, trim(tag(i)) // ":" |
---|
| 129 | print *, 'Not of type "nf90_float or "nf90_double".' |
---|
| 130 | end if |
---|
| 131 | end do |
---|
| 132 | |
---|
| 133 | call nf95_close(ncid1) |
---|
| 134 | call nf95_close(ncid2) |
---|
| 135 | |
---|
| 136 | end program max_diff_nc |
---|