3#if defined ADJOINT && defined IMPULSE
51# if defined PIO_LIB && defined DISTRIBUTE
63 integer,
intent(in) :: ng, tile, model
65 character (len=*),
intent(in) :: inpncname
69 integer :: lbi, ubi, lbj, ubj
71 character (len=*),
parameter :: myfile = &
83 SELECT CASE (
lze(ng)%IOtype)
88# if defined PIO_LIB && defined DISTRIBUTE
99 10
FORMAT (
' WRT_IMPULSE - Illegal output file type, io_type = ',i0, &
100 & /,15x,
'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
107 & LBi, UBi, LBj, UBj)
114 integer,
intent(in) :: ng, tile, model
116 character (len=*),
intent(in) :: inpncname
120 integer :: lbi, ubi, lbj, ubj
121 integer :: iinp, iout, irec, mytype, nrec
122 integer :: inpncid, inpvid
123 integer :: i, gtype, status, varid
124 integer :: ibuffer(2), vsize(4)
126 integer(i8b) :: fhash
129 real(r8) :: fmin, fmax
131 real(dp) :: inp_time(1)
133 character (len=*),
parameter :: myfile = &
134 & __FILE__//
", wrt_impulse_nf90"
136# include "set_bounds.h"
175 CALL netcdf_open (ng, model, inpncname, 0, inpncid)
177 WRITE (
stdout,20) trim(inpncname)
207 &
rclock%DateNumber, inp_time, &
209 & start = (/irec/), total = (/1/))
215 & ncid =
tlf(ng)%ncid)
228 status=
nf_fread2d(ng, model, inpncname, inpncid, &
230 & irec, mytype, vsize, &
231 & lbi, ubi, lbj, ubj, &
232 & scale, fmin, fmax, &
234 &
grid(ng) % rmask, &
237 &
ocean(ng) % ad_zeta(:,:,iinp), &
240 &
ocean(ng) % ad_zeta(:,:,iinp))
242 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
265 & lbi, ubi, lbj, ubj, scale, &
267 &
grid(ng) % rmask, &
269 &
ocean(ng) % ad_zeta(:,:,iinp))
270 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
293 status=
nf_fread2d(ng, model, inpncname, inpncid, &
295 & irec, mytype, vsize, &
296 & lbi, ubi, lbj, ubj, &
297 & scale, fmin, fmax, &
299 &
grid(ng) % umask_full, &
302 &
ocean(ng) % ad_ubar(:,:,iinp), &
305 &
ocean(ng) % ad_ubar(:,:,iinp))
307 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
330 & lbi, ubi, lbj, ubj, scale, &
332 &
grid(ng) % umask_full, &
334 &
ocean(ng) % ad_ubar(:,:,iinp))
335 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
356 status=
nf_fread2d(ng, model, inpncname, inpncid, &
358 & irec, mytype, vsize, &
359 & lbi, ubi, lbj, ubj, &
360 & scale, fmin, fmax, &
362 &
grid(ng) % vmask_full, &
365 &
ocean(ng) % ad_vbar(:,:,iinp), &
368 &
ocean(ng) % ad_vbar(:,:,iinp))
370 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
393 & lbi, ubi, lbj, ubj, scale, &
395 &
grid(ng) % vmask_full, &
397 &
ocean(ng) % ad_vbar(:,:,iinp))
398 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
421 status=
nf_fread3d(ng, model, inpncname, inpncid, &
423 & irec, mytype, vsize, &
424 & lbi, ubi, lbj, ubj, 1,
n(ng), &
425 & scale, fmin, fmax, &
427 &
grid(ng) % umask_full, &
430 &
ocean(ng) % ad_u(:,:,:,iinp), &
433 &
ocean(ng) % ad_u(:,:,:,iinp))
435 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
457 & lbi, ubi, lbj, ubj, 1,
n(ng), scale, &
459 &
grid(ng) % umask_full, &
461 &
ocean(ng) % ad_u(:,:,:,iinp))
462 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
483 status=
nf_fread3d(ng, model, inpncname, inpncid, &
485 & irec, mytype, vsize, &
486 & lbi, ubi, lbj, ubj, 1,
n(ng), &
487 & scale, fmin, fmax, &
489 &
grid(ng) % vmask_full, &
492 &
ocean(ng) % ad_v(:,:,:,iinp), &
495 &
ocean(ng) % ad_v(:,:,:,iinp))
497 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
519 & lbi, ubi, lbj, ubj, 1,
n(ng), scale, &
521 &
grid(ng) % vmask_full, &
523 &
ocean(ng) % ad_v(:,:,:,iinp))
524 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
547 status=
nf_fread3d(ng, model, inpncname, inpncid, &
549 & irec, mytype, vsize, &
550 & lbi, ubi, lbj, ubj, 1,
n(ng), &
551 & scale, fmin, fmax, &
553 &
grid(ng) % rmask, &
556 &
ocean(ng) % ad_t(:,:,:,iinp,i), &
559 &
ocean(ng) % ad_t(:,:,:,iinp,i))
561 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
583 & lbi, ubi, lbj, ubj, 1,
n(ng), scale, &
585 &
grid(ng) % rmask, &
587 &
ocean(ng) % ad_t(:,:,:,iinp,i))
588 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
609 CALL netcdf_close (ng, model, inpncid, inpncname, .false.)
611 WRITE (
stdout,70) trim(inpncname)
623 10
FORMAT (2x,
'WRT_IMPULSE_NF90 - processing convolved adjoint', &
624 &
' impulses, records: 1 to ',i0,/,21x,
'file: ',a)
625 20
FORMAT (/,
' WRT_IMPULSE_NF90 - unable to open input NetCDF', &
627 30
FORMAT (/,
' WRT_IMPULSE_NF90 - cannot find state variable: ',a, &
628 & /,20x,
'in input NetCDF file: ',a)
629 40
FORMAT (/,
' WRT_IMPULSE_NF90 - error while reading variable: ',a, &
630 & 2x,
'at time record = ',i0, &
631 & /,20x,
'in input NetCDF file: ',a)
633 50
FORMAT (19x,
'- ',a,/,22x,
'(Rec = ',i0,
' Min = ',1p,e15.8, &
634 &
' Max = ',1p,e15.8,
' CheckSum = ',i0,
')')
636 50
FORMAT (19x,
'- ',a,/,22x,
'(Rec = ',i0,
' Min = ',1p,e15.8, &
637 &
' Max = ',1p,e15.8,
')')
639 60
FORMAT (/,
' WRT_IMPULSE_NF90 - error while writing variable: ',a, &
640 & 2x,
'at time record = ',i0,/,20x,
'into NetCDF file: ',a)
641 70
FORMAT (/,
' WRT_IMPULSE_NF90 - unable to close input NetCDF', &
647# if defined PIO_LIB && defined DISTRIBUTE
651 & LBi, UBi, LBj, UBj)
658 integer,
intent(in) :: ng, tile, model
660 character (len=*),
intent(in) :: inpncname
664 integer :: lbi, ubi, lbj, ubj
665 integer :: iinp, iout, irec, nrec
666 integer :: inpncid, inpvid
668 integer :: ibuffer(2), vsize(4)
670 integer(i8b) :: fhash
673 real(r8) :: fmin, fmax
675 real(dp) :: inp_time(1)
677 character (len=*),
parameter :: myfile = &
678 & __FILE__//
", wrt_impulse_pio"
680 TYPE (io_desc_t),
pointer :: iodesc
681 TYPE (file_desc_t) :: piofile
685# include "set_bounds.h"
726 WRITE (
stdout,20) trim(inpncname)
757 &
rclock%DateNumber, inp_time, &
758 & piofile = piofile, &
759 & start = (/irec/), &
766 & piofile =
tlf(ng)%pioFile)
779 IF (kind(
ocean(ng)%ad_zeta).eq.8)
THEN
780 piovar%dkind=pio_double
783 piovar%dkind=pio_real
788 status=
nf_fread2d(ng, model, inpncname, piofile, &
791 & lbi, ubi, lbj, ubj, &
792 & scale, fmin, fmax, &
794 &
grid(ng) % rmask, &
797 &
ocean(ng) % ad_zeta(:,:,iinp), &
800 &
ocean(ng) % ad_zeta(:,:,iinp))
802 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
821 IF (
tlf(ng)%pioVar(
idztlf)%dkind.eq.pio_double)
THEN
830 & lbi, ubi, lbj, ubj, scale, &
832 &
grid(ng) % rmask, &
834 &
ocean(ng) % ad_zeta(:,:,iinp))
835 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
858 IF (kind(
ocean(ng)%ad_ubar).eq.8)
THEN
859 piovar%dkind=pio_double
862 piovar%dkind=pio_real
867 status=
nf_fread2d(ng, model, inpncname, piofile, &
870 & lbi, ubi, lbj, ubj, &
871 & scale, fmin, fmax, &
873 &
grid(ng) % umask_full, &
876 &
ocean(ng) % ad_ubar(:,:,iinp), &
879 &
ocean(ng) % ad_ubar(:,:,iinp))
881 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
900 IF (
tlf(ng)%pioVar(
idubtf)%dkind.eq.pio_double)
THEN
909 & lbi, ubi, lbj, ubj, scale, &
911 &
grid(ng) % umask_full, &
913 &
ocean(ng) % ad_ubar(:,:,iinp))
914 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
935 IF (kind(
ocean(ng)%ad_vbar).eq.8)
THEN
936 piovar%dkind=pio_double
939 piovar%dkind=pio_real
944 status=
nf_fread2d(ng, model, inpncname, piofile, &
947 & lbi, ubi, lbj, ubj, &
948 & scale, fmin, fmax, &
950 &
grid(ng) % vmask_full, &
953 &
ocean(ng) % ad_vbar(:,:,iinp), &
956 &
ocean(ng) % ad_vbar(:,:,iinp))
958 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
977 IF (
tlf(ng)%pioVar(
idvbtf)%dkind.eq.pio_double)
THEN
986 & lbi, ubi, lbj, ubj, scale, &
988 &
grid(ng) % vmask_full, &
990 &
ocean(ng) % ad_vbar(:,:,iinp))
991 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
1014 IF (kind(
ocean(ng)%ad_u).eq.8)
THEN
1015 piovar%dkind=pio_double
1018 piovar%dkind=pio_real
1023 status=
nf_fread3d(ng, model, inpncname, piofile, &
1026 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1027 & scale, fmin, fmax, &
1029 &
grid(ng) % umask_full, &
1032 &
ocean(ng) % ad_u(:,:,:,iinp), &
1035 &
ocean(ng) % ad_u(:,:,:,iinp))
1037 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
1056 IF (
tlf(ng)%pioVar(
idutlf)%dkind.eq.pio_double)
THEN
1065 & lbi, ubi, lbj, ubj, 1,
n(ng), scale, &
1067 &
grid(ng) % umask_full, &
1069 &
ocean(ng) % ad_u(:,:,:,iinp))
1070 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
1073 & trim(
tlf(ng)%name)
1091 IF (kind(
ocean(ng)%ad_v).eq.8)
THEN
1092 piovar%dkind=pio_double
1095 piovar%dkind=pio_real
1100 status=
nf_fread3d(ng, model, inpncname, piofile, &
1103 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1104 & scale, fmin, fmax, &
1106 &
grid(ng) % vmask_full, &
1109 &
ocean(ng) % ad_v(:,:,:,iinp), &
1112 &
ocean(ng) % ad_v(:,:,:,iinp))
1114 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
1133 IF (
tlf(ng)%pioVar(
idvtlf)%dkind.eq.pio_double)
THEN
1142 & lbi, ubi, lbj, ubj, 1,
n(ng), scale, &
1144 &
grid(ng) % vmask_full, &
1146 &
ocean(ng) % ad_v(:,:,:,iinp))
1147 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
1150 & trim(
tlf(ng)%name)
1170 IF (kind(
ocean(ng)%ad_t).eq.8)
THEN
1171 piovar%dkind=pio_double
1174 piovar%dkind=pio_real
1179 status=
nf_fread3d(ng, model, inpncname, piofile, &
1181 & irec, iodesc, vsize, &
1182 & lbi, ubi, lbj, ubj, 1,
n(ng), &
1183 & scale, fmin, fmax, &
1185 &
grid(ng) % rmask, &
1188 &
ocean(ng) % ad_t(:,:,:,iinp,i), &
1191 &
ocean(ng) % ad_t(:,:,:,iinp,i))
1193 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
1212 IF (
tlf(ng)%pioTrc(i)%dkind.eq.pio_double)
THEN
1219 &
tlf(ng)%pioTrc(i), iout, &
1221 & lbi, ubi, lbj, ubj, 1,
n(ng), scale, &
1223 &
grid(ng) % rmask, &
1225 &
ocean(ng) % ad_t(:,:,:,iinp,i))
1226 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
1229 & trim(
tlf(ng)%name)
1249 WRITE (
stdout,70) trim(inpncname)
1261 10
FORMAT (2x,
'WRT_IMPULSE_PIO - processing convolved adjoint', &
1262 &
' impulses, records: 1 to ',i0,/,21x,
'file: ',a)
1263 20
FORMAT (/,
' WRT_IMPULSE_PIO - unable to open input NetCDF', &
1265 30
FORMAT (/,
' WRT_IMPULSE_PIO - cannot find state variable: ',a, &
1266 & /,20x,
'in input NetCDF file: ',a)
1267 40
FORMAT (/,
' WRT_IMPULSE_PIO - error while reading variable: ',a, &
1268 & 2x,
'at time record = ',i0, &
1269 & /,20x,
'in input NetCDF file: ',a)
1271 50
FORMAT (19x,
'- ',a,/,22x,
'(Rec = ',i0,
' Min = ',1p,e15.8, &
1272 &
' Max = ',1p,e15.8,
' CheckSum = ',i0,
')')
1274 50
FORMAT (19x,
'- ',a,/,22x,
'(Rec = ',i0,
' Min = ',1p,e15.8, &
1275 &
' Max = ',1p,e15.8,
')')
1277 60
FORMAT (/,
' WRT_IMPULSE_PIO - error while writing variable: ',a, &
1278 & 2x,
'at time record = ',i0,/,20x,
'into NetCDF file: ',a)
1279 70
FORMAT (/,
' WRT_IMPULSE_PIO - unable to close input NetCDF', &
type(t_grid), dimension(:), allocatable grid
type(t_io), dimension(:), allocatable tlf
type(t_io), dimension(:), allocatable lze
character(len=256) sourcefile
integer, parameter io_nf90
integer, parameter io_pio
integer, dimension(:), allocatable idttlf
character(len=maxlen), dimension(6, 0:nv) vname
subroutine, public netcdf_close(ng, model, ncid, ncname, lupdate)
integer, dimension(mvars) var_flag
subroutine, public netcdf_check_dim(ng, model, ncname, ncid)
subroutine, public netcdf_open(ng, model, ncname, omode, ncid)
character(len=100), dimension(mvars) var_name
subroutine, public netcdf_sync(ng, model, ncname, ncid)
subroutine, public netcdf_inq_var(ng, model, ncname, ncid, myvarname, searchvar, varid, nvardim, nvaratt)
type(t_ocean), dimension(:), allocatable ocean
integer, dimension(:), allocatable n
type(t_bounds), dimension(:), allocatable bounds
integer, parameter r3dvar
integer, parameter u3dvar
integer, parameter u2dvar
integer, dimension(:), allocatable nt
integer, parameter r2dvar
integer, parameter v2dvar
integer, parameter v3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dvar
subroutine, public pio_netcdf_sync(ng, model, ncname, piofile)
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dvar
type(var_desc_t), dimension(:), pointer var_desc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
subroutine, public pio_netcdf_close(ng, model, piofile, ncname, lupdate)
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dvar
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar
logical function, public find_string(a, asize, string, aindex)
logical function, public founderror(flag, noerr, line, routine)
subroutine, private wrt_impulse_nf90(ng, tile, model, inpncname, lbi, ubi, lbj, ubj)
subroutine, private wrt_impulse_pio(ng, tile, model, inpncname, lbi, ubi, lbj, ubj)
subroutine, public wrt_impulse(ng, tile, model, inpncname)