80 & t2dgrd, u2dgrd, v2dgrd, &
88 logical,
intent(in) :: ldef, varout(
nv,
ngrids)
90 integer,
intent(in) :: ng, model
91 integer,
intent(in),
optional :: t2dgrd(:), u2dgrd(:), v2dgrd(:)
92 integer,
intent(in),
optional :: b3dgrd(:)
98 logical :: got_var(
nv)
100 integer,
parameter :: natt = 25
102 integer :: i, itrc, j, nvd3, nvd4, status
107 character (len=21) :: prefix
109 character (len=13) :: prefix
111 character (len=120) :: vinfo(natt)
112 character (len=256) :: ncname
114 character (len=*),
parameter :: myfile = &
115 & __FILE__//
", sediment_def_nf90"
126 define :
IF (ldef)
THEN
130# if defined WRITE_WATER && defined MASKING
159# if defined SEDIMENT && defined SED_MORPH
163 IF (varout(
idbath,ng))
THEN
165 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
166 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,
idbath))
173 vinfo(22)=
'coordinates'
176 &
nf_fout, nvd3, t2dgrd, aval, vinfo, ncname, &
177 & setfillval = .false.)
182# if defined SEDIMENT && defined BEDLOAD
187 IF (varout(
idubld(i),ng))
THEN
189 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
190 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
198# if defined WRITE_WATER && defined MASKING
202 vinfo(22)=
'coordinates'
204 status=
def_var(ng, model, s(ng)%ncid, &
206 & nvd3, u2dgrd, aval, vinfo, ncname)
212 IF (varout(
idvbld(i),ng))
THEN
214 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
215 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
223# if defined WRITE_WATER && defined MASKING
227 vinfo(22)=
'coordinates'
229 status=
def_var(ng, model, s(ng)%ncid, &
231 & nvd3, v2dgrd, aval, vinfo, ncname)
242 IF (varout(
idfrac(i),ng))
THEN
244 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
245 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
253 WRITE (vinfo(19),10) 1000.0_r8*
sd50(i,ng)
254# if defined WRITE_WATER && defined MASKING
258 vinfo(22)=
'coordinates'
260 status=
def_var(ng, model, s(ng)%ncid, &
262 & nvd4, b3dgrd, aval, vinfo, ncname)
270 IF (varout(
idbmas(i),ng))
THEN
272 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
273 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
281 WRITE (vinfo(19),10) 1000.0_r8*
sd50(i,ng)
282# if defined WRITE_WATER && defined MASKING
286 vinfo(22)=
'coordinates'
288 status=
def_var(ng, model, s(ng)%ncid, &
290 & nvd4, b3dgrd, aval, vinfo, ncname)
298 IF (varout(
idsbed(i),ng))
THEN
300 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
301 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
309# if defined WRITE_WATER && defined MASKING
313 vinfo(22)=
'coordinates'
315 status=
def_var(ng, model, s(ng)%ncid, &
317 & nvd4, b3dgrd, aval, vinfo, ncname)
323# if defined SEDIMENT || defined BBL_MODEL
328 IF (varout(
idbott(i),ng))
THEN
330 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
331 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
339# if defined WRITE_WATER && defined MASKING
343 vinfo(22)=
'coordinates'
345 status=
def_var(ng, model, s(ng)%ncid, &
347 & nvd3, t2dgrd, aval, vinfo, ncname)
353# if defined SEDIMENT && defined BEDLOAD && defined BEDLOAD_VANDERA
357 IF (varout(idsurs,ng))
THEN
358 vinfo( 1)=
vname(1,idsurs)
359 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
360 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsurs))
362 vinfo( 2)=
vname(2,idsurs)
364 vinfo( 3)=
vname(3,idsurs)
365 vinfo(14)=
vname(4,idsurs)
366 vinfo(16)=
vname(1,idsurs)
367# if defined WRITE_WATER && defined MASKING
370 vinfo(21)=
vname(6,idsurs)
371 vinfo(22)=
'coordinates'
372 aval(5)=real(
iinfo(1,idsurs,ng),r8)
373 status=
def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idsurs), &
374 &
nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
380 IF (varout(idsrrw,ng))
THEN
381 vinfo( 1)=
vname(1,idsrrw)
382 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
383 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsrrw))
385 vinfo( 2)=
vname(2,idsrrw)
387 vinfo( 3)=
vname(3,idsrrw)
388 vinfo(14)=
vname(4,idsrrw)
389 vinfo(16)=
vname(1,idsrrw)
390# if defined WRITE_WATER && defined MASKING
393 vinfo(21)=
vname(6,idsrrw)
394 vinfo(22)=
'coordinates'
395 aval(5)=real(
iinfo(1,idsrrw,ng),r8)
396 status=
def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idsrrw), &
397 &
nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
403 IF (varout(idsbtw,ng))
THEN
404 vinfo( 1)=
vname(1,idsbtw)
405 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
406 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsbtw))
408 vinfo( 2)=
vname(2,idsbtw)
410 vinfo( 3)=
vname(3,idsbtw)
411 vinfo(14)=
vname(4,idsbtw)
412 vinfo(16)=
vname(1,idsbtw)
413# if defined WRITE_WATER && defined MASKING
416 vinfo(21)=
vname(6,idsbtw)
417 vinfo(22)=
'coordinates'
418 aval(5)=real(
iinfo(1,idsbtw,ng),r8)
419 status=
def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idsbtw), &
420 &
nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
426 IF (varout(idsucr,ng))
THEN
427 vinfo( 1)=
vname(1,idsucr)
428 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
429 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsucr))
431 vinfo( 2)=
vname(2,idsucr)
433 vinfo( 3)=
vname(3,idsucr)
434 vinfo(14)=
vname(4,idsucr)
435 vinfo(16)=
vname(1,idsucr)
436# if defined WRITE_WATER && defined MASKING
439 vinfo(21)=
vname(6,idsucr)
440 vinfo(22)=
'coordinates'
441 aval(5)=real(
iinfo(1,idsucr,ng),r8)
442 status=
def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idsucr), &
443 &
nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
449 IF (varout(idsutr,ng))
THEN
450 vinfo( 1)=
vname(1,idsutr)
451 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
452 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsutr))
454 vinfo( 2)=
vname(2,idsutr)
456 vinfo( 3)=
vname(3,idsutr)
457 vinfo(14)=
vname(4,idsutr)
458 vinfo(16)=
vname(1,idsutr)
459# if defined WRITE_WATER && defined MASKING
462 vinfo(21)=
vname(6,idsutr)
463 vinfo(22)=
'coordinates'
464 aval(5)=real(
iinfo(1,idsutr,ng),r8)
465 status=
def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idsutr), &
466 &
nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
472 IF (varout(idstcr,ng))
THEN
473 vinfo( 1)=
vname(1,idstcr)
474 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
475 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idstcr))
477 vinfo( 2)=
vname(2,idstcr)
479 vinfo( 3)=
vname(3,idstcr)
480 vinfo(14)=
vname(4,idstcr)
481 vinfo(16)=
vname(1,idstcr)
482# if defined WRITE_WATER && defined MASKING
485 vinfo(21)=
vname(6,idstcr)
486 vinfo(22)=
'coordinates'
487 aval(5)=real(
iinfo(1,idstcr,ng),r8)
488 status=
def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idstcr), &
489 &
nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
495 IF (varout(idsttr,ng))
THEN
496 vinfo( 1)=
vname(1,idsttr)
497 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
498 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsttr))
500 vinfo( 2)=
vname(2,idsttr)
502 vinfo( 3)=
vname(3,idsttr)
503 vinfo(14)=
vname(4,idsttr)
504 vinfo(16)=
vname(1,idsttr)
505# if defined WRITE_WATER && defined MASKING
508 vinfo(21)=
vname(6,idsttr)
509 vinfo(22)=
'coordinates'
510 aval(5)=real(
iinfo(1,idsttr,ng),r8)
511 status=
def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idsttr), &
512 &
nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
524 query :
IF (.not.ldef)
THEN
539# if defined SEDIMENT && defined SED_MORPH
544# if defined SEDIMENT && defined BEDLOAD && defined BEDLOAD_VANDERA
546 got_var(idsurs)=.true.
547 s(ng)%Vid(idsurs)=
var_id(i)
549 got_var(idsrrw)=.true.
550 s(ng)%Vid(idsrrw)=
var_id(i)
552 got_var(idsbtw)=.true.
553 s(ng)%Vid(idsbtw)=
var_id(i)
555 got_var(idsucr)=.true.
556 s(ng)%Vid(idsucr)=
var_id(i)
558 got_var(idsutr)=.true.
559 s(ng)%Vid(idsutr)=
var_id(i)
561 got_var(idstcr)=.true.
562 s(ng)%Vid(idstcr)=
var_id(i)
564 got_var(idsttr)=.true.
565 s(ng)%Vid(idsttr)=
var_id(i)
572 got_var(
idfrac(itrc))=.true.
576 got_var(
idbmas(itrc))=.true.
581 got_var(
idubld(itrc))=.true.
585 got_var(
idvbld(itrc))=.true.
592 got_var(
idsbed(itrc))=.true.
597# if defined SEDIMENT || defined BBL_MODEL
600 got_var(
idbott(itrc))=.true.
609 IF (.not.got_var(
idtime))
THEN
615# if defined SEDIMENT && defined SED_MORPH
623# if defined SEDIMENT && defined BEDLOAD && defined BEDLOAD_VANDERA
624 IF (.not.got_var(idsurs).and.varout(idsurs,ng))
THEN
630 IF (.not.got_var(idsrrw).and.varout(idsrrw,ng))
THEN
636 IF (.not.got_var(idsbtw).and.varout(idsbtw,ng))
THEN
642 IF (.not.got_var(idsucr).and.varout(idsucr,ng))
THEN
648 IF (.not.got_var(idsutr).and.varout(idsutr,ng))
THEN
654 IF (.not.got_var(idstcr).and.varout(idstcr,ng))
THEN
660 IF (.not.got_var(idsttr).and.varout(idsttr,ng))
THEN
669 IF (.not.got_var(
idfrac(i)).and.varout(
idfrac(i),ng))
THEN
676 IF(.not.got_var(
idbmas(i)).and.varout(
idbmas(i),ng))
THEN
683 IF (.not.got_var(
idubld(i)).and.varout(
idubld(i),ng))
THEN
689 IF (.not.got_var(
idvbld(i)).and.varout(
idvbld(i),ng))
THEN
698 IF (.not.got_var(
idsbed(i)).and.varout(
idsbed(i),ng))
THEN
706# if defined SEDIMENT || defined BBL_MODEL
708 IF (.not.got_var(
idbott(i)).and.varout(
idbott(i),ng))
THEN
718 10
FORMAT (1pe11.4,1x,
'millimeter')
719 20
FORMAT (/,
' SEDIMENT_DEF_NF90 - unable to find variable: ', &
720 & a,2x,
' in output NetCDF file: ',a)
736 logical,
intent(in) :: ldef, varout(
nv,
ngrids)
738 integer,
intent(in) :: ng, model
739 integer,
intent(in),
optional :: bgrd(:), pgrd(:), rgrd(:)
745 logical :: got_var(
nv)
747 integer,
parameter :: natt = 25
749 integer :: i, itrc, j, status
753 character (len=120) :: vinfo(natt)
754 character (len=256) :: ncname
756 character (len=*),
parameter :: myfile = &
757 & __FILE__//
", sediment_def_station_nf90"
768 define :
IF (ldef)
THEN
781# if defined SEDIMENT && defined SED_MORPH
785 IF (varout(
idbath,ng))
THEN
792 &
nf_fout, 2, pgrd, aval, vinfo, ncname, &
793 & setfillval = .false., &
794 & setparaccess = .true.)
804 IF (varout(
idfrac(i),ng))
THEN
810 WRITE (vinfo(19),10) 1000.0_r8*
sd50(i,ng)
811 status=
def_var(ng, model, s(ng)%ncid, &
813 & 3, bgrd, aval, vinfo, ncname, &
814 & setfillval = .true., &
815 & setparaccess = .true.)
821 IF (varout(
idbmas(i),ng))
THEN
827 WRITE (vinfo(19),10) 1000.0_r8*
sd50(i,ng)
828 status=
def_var(ng, model, s(ng)%ncid, &
830 & 3, bgrd, aval, vinfo, ncname, &
831 & setfillval = .true., &
832 & setparaccess = .true.)
840 IF (varout(
idsbed(i),ng))
THEN
846 status=
def_var(ng, model, s(ng)%ncid, &
848 & 3, bgrd, aval, vinfo, ncname, &
849 & setfillval = .true., &
850 & setparaccess = .true.)
856# if defined SEDIMENT || defined BBL_MODEL
861 IF (varout(
idbott(i),ng))
THEN
867 status=
def_var(ng, model, s(ng)%ncid, &
869 & 2, pgrd, aval, vinfo, ncname, &
870 & setfillval = .true., &
871 & setparaccess = .true.)
884 query :
IF (.not.ldef)
THEN
899# if defined SEDIMENT && defined SED_MORPH
908 got_var(
idfrac(itrc))=.true.
912 got_var(
idbmas(itrc))=.true.
918 got_var(
idsbed(itrc))=.true.
923# if defined SEDIMENT || defined BBL_MODEL
926 got_var(
idbott(itrc))=.true.
935 IF (.not.got_var(
idtime))
THEN
941# if defined SEDIMENT && defined SED_MORPH
951 IF (.not.got_var(
idfrac(i)).and.varout(
idfrac(i),ng))
THEN
957 IF (.not.got_var(
idbmas(i)).and.varout(
idbmas(i),ng))
THEN
965 IF (.not.got_var(
idsbed(i)).and.varout(
idsbed(i),ng))
THEN
973# if defined SEDIMENT || defined BBL_MODEL
975 IF (.not.got_var(
idbott(i)).and.varout(
idbott(i),ng))
THEN
986 10
FORMAT (1pe11.4,1x,
'millimeter')
987 20
FORMAT (/,
' SEDIMENT_DEF_STATION_NF90 - unable to find variable:',&
988 & 1x,a,2x,
' in output NetCDF file: ',a)
996 & LBi, UBi, LBj, UBj, &
1004 logical,
intent(in) :: varout(
nv,
ngrids)
1006 integer,
intent(in) :: ng, model, tile
1007 integer,
intent(in) :: lbi, ubi, lbj, ubj
1013 logical :: linstataneous
1015 integer :: gfactor, gtype, i, status
1019 character (len=*),
parameter :: myfile = &
1020 & __FILE__//
", sediment_wrt_nf90"
1034# if defined WRITE_WATER && defined MASKING
1042 IF ((s(ng)%ncid.eq.s(ng)%ncid).or. &
1043 & (s(ng)%ncid.eq.
qck(ng)%ncid))
THEN
1044 linstataneous=.true.
1046 linstataneous=.false.
1049# if defined SEDIMENT && defined SED_MORPH
1053 IF (varout(
idbath,ng))
THEN
1056 IF (linstataneous)
THEN
1059 & s(ng)%Rindex, gtype, &
1060 & lbi, ubi, lbj, ubj, scale, &
1062 &
grid(ng) % rmask, &
1065 & setfillval = .false.)
1066 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1078# if defined SEDIMENT && defined BEDLOAD
1083 IF (varout(
idubld(i),ng))
THEN
1086 IF (linstataneous)
THEN
1088 & s(ng)%Vid(
idubld(i)), &
1089 & s(ng)%Rindex, gtype, &
1090 & lbi, ubi, lbj, ubj, scale, &
1092 &
grid(ng) % umask, &
1094 &
sedbed(ng) % bedldu(:,:,i))
1098 & s(ng)%Vid(
idubld(i)), &
1099 & s(ng)%Rindex, gtype, &
1100 & lbi, ubi, lbj, ubj, scale, &
1102 &
grid(ng) % umask, &
1104 &
sedbed(ng) % avgbedldu(:,:,i))
1107 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1119 IF (varout(
idvbld(i),ng))
THEN
1122 IF (linstataneous)
THEN
1124 & s(ng)%Vid(
idvbld(i)), &
1125 & s(ng)%Rindex, gtype, &
1126 & lbi, ubi, lbj, ubj, scale, &
1128 &
grid(ng) % vmask, &
1130 &
sedbed(ng) % bedldv(:,:,i))
1134 & s(ng)%Vid(
idvbld(i)), &
1135 & s(ng)%Rindex, gtype, &
1136 & lbi, ubi, lbj, ubj, scale, &
1138 &
grid(ng) % vmask, &
1140 &
sedbed(ng) % avgbedldv(:,:,i))
1143 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1160 IF (varout(
idfrac(i),ng))
THEN
1164 & s(ng)%Vid(
idfrac(i)), &
1165 & s(ng)%Rindex, gtype, &
1166 & lbi, ubi, lbj, ubj, 1,
nbed, scale, &
1168 &
grid(ng) % rmask, &
1170 &
sedbed(ng) % bed_frac(:,:,:,i))
1171 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1185 IF (varout(
idbmas(i),ng))
THEN
1189 & s(ng)%Vid(
idbmas(i)), &
1190 & s(ng)%Rindex, gtype, &
1191 & lbi, ubi, lbj, ubj, 1,
nbed, scale, &
1193 &
grid(ng) % rmask, &
1195 &
sedbed(ng) % bed_mass(:,:,:,nout,i))
1196 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1210 IF (varout(
idsbed(i),ng))
THEN
1214 & s(ng)%Vid(
idsbed(i)), &
1215 & s(ng)%Rindex, gtype, &
1216 & lbi, ubi, lbj, ubj, 1,
nbed, scale, &
1218 &
grid(ng) % rmask, &
1220 &
sedbed(ng) % bed(:,:,:,i))
1221 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1233# if defined SEDIMENT || defined BBL_MODEL
1238 IF (varout(
idbott(i),ng))
THEN
1239 IF (i.eq.
itauc)
THEN
1246 & s(ng)%Vid(
idbott(i)), &
1247 & s(ng)%Rindex, gtype, &
1248 & lbi, ubi, lbj, ubj, scale, &
1250 &
grid(ng) % rmask, &
1252 &
sedbed(ng) % bottom(:,:,i))
1253 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1265# if defined SEDIMENT && defined BEDLOAD && defined SED_BEDLOAD_VANDERA
1269 IF (varout(idsurs,ng))
THEN
1272 status=
nf_fwrite2d(ng, model, s(ng)%ncid, idsurs, &
1273 & s(ng)%Vid(idsurs), &
1274 & s(ng)%Rindex, gtype, &
1275 & lbi, ubi, lbj, ubj, scale, &
1277 &
grid(ng) % rmask, &
1279 &
sedbed(ng) % ursell_no)
1280 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1282 WRITE (
stdout,10) trim(
vname(1,idsurs)), s(ng)%Rindex
1292 IF (varout(idsrrw,ng))
THEN
1295 status=
nf_fwrite2d(ng, model, s(ng)%ncid, idsrrw, &
1296 & s(ng)%Vid(idsrrw), &
1297 & s(ng)%Rindex, gtype, &
1298 & lbi, ubi, lbj, ubj, scale, &
1300 &
grid(ng) % rmask, &
1302 &
sedbed(ng) % RR_asymwave)
1303 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1305 WRITE (
stdout,10) trim(
vname(1,idsrrw)), s(ng)%Rindex
1315 IF (varout(idsbtw,ng))
THEN
1318 status=
nf_fwrite2d(ng, model, s(ng)%ncid, idsbtw, &
1319 & s(ng)%Vid(idsbtw), &
1320 & s(ng)%Rindex, gtype, &
1321 & lbi, ubi, lbj, ubj, scale, &
1323 &
grid(ng) % rmask, &
1325 &
sedbed(ng) % beta_asymwave)
1326 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1328 WRITE (
stdout,10) trim(
vname(1,idsbtw)), s(ng)%Rindex
1338 IF (varout(idsucr,ng))
THEN
1341 status=
nf_fwrite2d(ng, model, s(ng)%ncid, idsucr, &
1342 & s(ng)%Vid(idsucr), &
1343 & s(ng)%Rindex, gtype, &
1344 & lbi, ubi, lbj, ubj, scale, &
1346 &
grid(ng) % rmask, &
1349 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1351 WRITE (
stdout,10) trim(
vname(1,idsucr)), s(ng)%Rindex
1361 IF (varout(idsutr,ng))
THEN
1364 status=
nf_fwrite2d(ng, model, s(ng)%ncid, idsutr, &
1365 & s(ng)%Vid(idsutr), &
1366 & s(ng)%Rindex, gtype, &
1367 & lbi, ubi, lbj, ubj, scale, &
1369 &
grid(ng) % rmask, &
1371 &
sedbed(ng) % utrough_r)
1372 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1374 WRITE (
stdout,10) trim(
vname(1,idsutr)), s(ng)%Rindex
1384 IF (varout(idstcr,ng))
THEN
1387 status=
nf_fwrite2d(ng, model, s(ng)%ncid, idstcr, &
1388 & s(ng)%Vid(idstcr), &
1389 & s(ng)%Rindex, gtype, &
1390 & lbi, ubi, lbj, ubj, scale, &
1392 &
grid(ng) % rmask, &
1395 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1397 WRITE (
stdout,10) trim(
vname(1,idstcr)), s(ng)%Rindex
1407 IF (varout(idsttr,ng))
THEN
1410 status=
nf_fwrite2d(ng, model, s(ng)%ncid, idsttr, &
1411 & s(ng)%Vid(idsttr), &
1412 & s(ng)%Rindex, gtype, &
1413 & lbi, ubi, lbj, ubj, scale, &
1415 &
grid(ng) % rmask, &
1418 IF (
founderror(status, nf90_noerr, __line__, myfile))
THEN
1420 WRITE (
stdout,10) trim(
vname(1,idsttr)), s(ng)%Rindex
1429 10
FORMAT (/,
" SEDIMENT_WRT_NF90 - error while writing variable '", &
1430 & a,
"', time record = ",i0,/,11x,
'into file: ',a)
1439 & LBi, UBi, LBj, UBj, &
1447 logical,
intent(in) :: varout(
nv,
ngrids)
1449 integer,
intent(in) :: ng, model, tile
1450 integer,
intent(in) :: lbi, ubi, lbj, ubj
1459 integer :: i, k, np, status
1463 real(r8),
dimension(Nstation(ng)) :: xpos, ypos, zpos, psta
1465 real(r8),
dimension(Nstation(ng)*Nbed) :: xposb, yposb, zposb
1466 real(r8),
dimension(Nstation(ng)*Nbed) :: bsta
1469 character (len=*),
parameter :: myfile = &
1470 & __FILE__//
", sediment_wrt_station_nf90"
1484# ifdef STATIONS_CGRID
1500 xposb(np)=
scalars(ng)%SposX(i)
1501 yposb(np)=
scalars(ng)%SposY(i)
1502 zposb(np)=real(k,r8)
1507# if defined SEDIMENT && defined SED_MORPH
1511 IF (varout(
idbath,ng))
THEN
1514 & lbi, ubi, lbj, ubj, &
1515 & scale,
grid(ng)%h, &
1519 & (/1,s(ng)%Rindex/), (/
nstation(ng),1/), &
1520 & ncid = s(ng)%ncid, &
1521 & varid = s(ng)%Vid(
idbath))
1531 IF (varout(
idfrac(i),ng))
THEN
1534 & lbi, ubi, lbj, ubj, 1,
nbed, &
1535 & scale,
sedbed(ng)%bed_frac(:,:,:,i), &
1536 & nposb, xposb, yposb, zposb, bsta)
1539 & (/1,1,s(ng)%Rindex/), &
1541 & ncid = s(ng)%ncid, &
1542 & varid = s(ng)%Vid(
idfrac(i)))
1548 IF (varout(
idbmas(i),ng))
THEN
1551 & lbi, ubi, lbj, ubj, 1,
nbed, &
1553 &
sedbed(ng)%bed_mass(:,:,:,nout,i), &
1554 & nposb, xposb, yposb, zposb, bsta)
1557 & (/1,1,s(ng)%Rindex/), &
1559 & ncid = s(ng)%ncid, &
1560 & varid = s(ng)%Vid(
idbmas(i)))
1568 IF (varout(
idsbed(i),ng))
THEN
1571 & lbi, ubi, lbj, ubj, 1,
nbed, &
1572 & scale,
sedbed(ng)%bed(:,:,:,i), &
1573 & nposb, xposb, yposb, zposb, bsta)
1576 & (/1,1,s(ng)%Rindex/), &
1578 & ncid = s(ng)%ncid, &
1579 & varid = s(ng)%Vid(
idsbed(i)))
1585# if defined SEDIMENT || defined BBL_MODEL
1590 IF (varout(
idbott(i),ng))
THEN
1593 & lbi, ubi, lbj, ubj, &
1594 & scale,
sedbed(ng)%bottom(:,:,i), &
1598 & (/1,s(ng)%Rindex/), &
1600 & ncid = s(ng)%ncid, &
1601 & varid = s(ng)%Vid(
idbott(i)))
1615 & t2dgrd, u2dgrd, v2dgrd, &
1616 & t3dgrd, u3dgrd, v3dgrd, w3dgrd)
1623 logical,
intent(in) :: ldef, varout(
nv,
ngrids)
1625 integer,
intent(in) :: ng, model
1626 integer,
intent(in),
optional :: t2dgrd(:), u2dgrd(:), v2dgrd(:)
1627 integer,
intent(in),
optional :: t3dgrd(:), u3dgrd(:), v3dgrd(:)
1628 integer,
intent(in),
optional :: w3dgrd(:)
1634 logical :: got_var(
nv)
1636 integer,
parameter :: natt = 25
1638 integer :: i, itrc, j, nvd3, nvd4, status
1643 character (len=21) :: prefix
1645 character (len=13) :: prefix
1647 character (len=120) :: vinfo(natt)
1648 character (len=256) :: ncname
1650 character (len=*),
parameter :: myfile = &
1651 & __FILE__//
", sediment_def_pio"
1662 define :
IF (ldef)
THEN
1666# if defined WRITE_WATER && defined MASKING
1687 DO j=1,len(vinfo(1))
1695# if defined SEDIMENT && defined SED_MORPH
1699 IF (varout(
idbath,ng))
THEN
1701 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
1702 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,
idbath))
1710 vinfo(22)=
'coordinates'
1715 status=
def_var(ng, model, s(ng)%pioFile, &
1716 & s(ng)%pioVar(
idbath)%vd, &
1717 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname, &
1718 & setfillval = .false.)
1723# if defined SEDIMENT && defined BEDLOAD
1728 IF (varout(
idubld(i),ng))
THEN
1730 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
1731 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
1739# if defined WRITE_WATER && defined MASKING
1743 vinfo(22)=
'coordinates'
1748 status=
def_var(ng, model, s(ng)%pioFile, &
1749 & s(ng)%pioVar(
idubld(i))%vd, &
1750 &
pio_fout, nvd3, u2dgrd, aval, vinfo, ncname)
1756 IF (varout(
idvbld(i),ng))
THEN
1758 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
1759 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
1767# if defined WRITE_WATER && defined MASKING
1771 vinfo(22)=
'coordinates'
1776 status=
def_var(ng, model, s(ng)%pioFile, &
1777 & s(ng)%pioVar(
idvbld(i))%vd, &
1778 &
pio_fout, nvd3, v2dgrd, aval, vinfo, ncname)
1789 IF (varout(
idfrac(i),ng))
THEN
1791 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
1792 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
1800 WRITE (vinfo(19),10) 1000.0_r8*
sd50(i,ng)
1801# if defined WRITE_WATER && defined MASKING
1802 vinfo(20)=
'mask_rho'
1805 vinfo(22)=
'coordinates'
1810 status=
def_var(ng, model, s(ng)%pioFile, &
1811 & s(ng)%pioVar(
idfrac(i))%vd, &
1812 &
pio_fout, nvd4, b3dgrd, aval, vinfo, ncname)
1820 IF (varout(
idbmas(i),ng))
THEN
1822 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
1823 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
1831 WRITE (vinfo(19),10) 1000.0_r8*
sd50(i,ng)
1832# if defined WRITE_WATER && defined MASKING
1833 vinfo(20)=
'mask_rho'
1836 vinfo(22)=
'coordinates'
1841 status=
def_var(ng, model, s(ng)%pioFile, &
1842 & s(ng)%pioVar(
idbmas(i))%vd, &
1843 &
pio_fout, nvd4, b3dgrd, aval, vinfo, ncname)
1851 IF (varout(
idsbed(i),ng))
THEN
1853 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
1854 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
1862# if defined WRITE_WATER && defined MASKING
1863 vinfo(20)=
'mask_rho'
1866 vinfo(22)=
'coordinates'
1871 status=
def_var(ng, model, s(ng)%pioFile, &
1872 & s(ng)%pioVar(
idsbed(i))%vd, &
1873 pio_fout, nvd4, b3dgrd, aval, vinfo, ncname)
1879# if defined SEDIMENT || defined BBL_MODEL
1884 IF (varout(
idbott(i),ng))
THEN
1886 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
1887 WRITE (vinfo( 2),
'(a,1x,a)') prefix, &
1895# if defined WRITE_WATER && defined MASKING
1896 vinfo(20)=
'mask_rho'
1899 vinfo(22)=
'coordinates'
1904 status=
def_var(ng, model, s(ng)%pioFile, &
1905 & s(ng)%pioVar(
idbott(i))%vd, &
1906 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
1912# if defined SEDIMENT && defined BEDLOAD && defined BEDLOAD_VANDERA
1916 IF (varout(idsurs,ng))
THEN
1917 vinfo( 1)=
vname(1,idsurs)
1918 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
1919 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsurs))
1921 vinfo( 2)=
vname(2,idsurs)
1923 vinfo( 3)=
vname(3,idsurs)
1924 vinfo(14)=
vname(4,idsurs)
1925 vinfo(16)=
vname(1,idsurs)
1926# if defined WRITE_WATER && defined MASKING
1927 vinfo(20)=
'mask_rho'
1929 vinfo(21)=
vname(6,idsurs)
1930 vinfo(22)=
'coordinates'
1931 aval(5)=real(
iinfo(1,idsurs,ng),r8)
1932 s(ng)%pioVar(idsurs)%dkind=
pio_fout
1933 s(ng)%pioVar(idsurs)%gtype=
r2dvar
1935 status=
def_var(ng, model, s(ng)%pioFile, &
1936 & s(ng)%pioVar(idsurs)%vd, &
1937 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
1943 IF (varout(idsrrw,ng))
THEN
1944 vinfo( 1)=
vname(1,idsrrw)
1945 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
1946 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsrrw))
1948 vinfo( 2)=
vname(2,idsrrw)
1950 vinfo( 3)=
vname(3,idsrrw)
1951 vinfo(14)=
vname(4,idsrrw)
1952 vinfo(16)=
vname(1,idsrrw)
1953# if defined WRITE_WATER && defined MASKING
1954 vinfo(20)=
'mask_rho'
1956 vinfo(21)=
vname(6,idsrrw)
1957 vinfo(22)=
'coordinates'
1958 aval(5)=real(
iinfo(1,idsrrw,ng),r8)
1959 s(ng)%pioVar(idsrrw)%dkind=
pio_fout
1960 s(ng)%pioVar(idsrrw)%gtype=
r2dvar
1962 status=
def_var(ng, model, s(ng)%pioFile, &
1963 & s(ng)%pioVar(idsrrw)%vd, &
1964 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
1970 IF (varout(idsbtw,ng))
THEN
1971 vinfo( 1)=
vname(1,idsbtw)
1972 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
1973 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsbtw))
1975 vinfo( 2)=
vname(2,idsbtw)
1977 vinfo( 3)=
vname(3,idsbtw)
1978 vinfo(14)=
vname(4,idsbtw)
1979 vinfo(16)=
vname(1,idsbtw)
1980# if defined WRITE_WATER && defined MASKING
1981 vinfo(20)=
'mask_rho'
1983 vinfo(21)=
vname(6,idsbtw)
1984 vinfo(22)=
'coordinates'
1985 aval(5)=real(
iinfo(1,idsbtw,ng),r8)
1986 s(ng)%pioVar(idsbtw)%dkind=
pio_fout
1987 s(ng)%pioVar(idsbtw)%gtype=
r2dvar
1989 status=
def_var(ng, model, s(ng)%pioFile, &
1990 & s(ng)%pioVar(idsbtw)%vd, &
1991 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
1997 IF (varout(idsucr,ng))
THEN
1998 vinfo( 1)=
vname(1,idsucr)
1999 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
2000 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsucr))
2002 vinfo( 2)=
vname(2,idsucr)
2004 vinfo( 3)=
vname(3,idsucr)
2005 vinfo(14)=
vname(4,idsucr)
2006 vinfo(16)=
vname(1,idsucr)
2007# if defined WRITE_WATER && defined MASKING
2008 vinfo(20)=
'mask_rho'
2010 vinfo(21)=
vname(6,idsucr)
2011 vinfo(22)=
'coordinates'
2012 aval(5)=real(
iinfo(1,idsucr,ng),r8)
2013 s(ng)%pioVar(idsucr)%dkind=
pio_fout
2014 s(ng)%pioVar(idsucr)%gtype=
r2dvar
2016 status=
def_var(ng, model, s(ng)%pioFile, &
2017 & s(ng)%pioVar(idsucr)%vd, &
2018 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
2024 IF (varout(idsutr,ng))
THEN
2025 vinfo( 1)=
vname(1,idsutr)
2026 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
2027 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsutr))
2029 vinfo( 2)=
vname(2,idsutr)
2031 vinfo( 3)=
vname(3,idsutr)
2032 vinfo(14)=
vname(4,idsutr)
2033 vinfo(16)=
vname(1,idsutr)
2034# if defined WRITE_WATER && defined MASKING
2035 vinfo(20)=
'mask_rho'
2037 vinfo(21)=
vname(6,idsutr)
2038 vinfo(22)=
'coordinates'
2039 aval(5)=real(
iinfo(1,idsutr,ng),r8)
2040 s(ng)%pioVar(idsutr)%dkind=
pio_fout
2041 s(ng)%pioVar(idsutr)%gtype=
r2dvar
2043 status=
def_var(ng, model, s(ng)%pioFile, &
2044 & s(ng)%pioVar(idsutr)%vd, &
2045 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
2051 IF (varout(idstcr,ng))
THEN
2052 vinfo( 1)=
vname(1,idstcr)
2053 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
2054 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idstcr))
2056 vinfo( 2)=
vname(2,idstcr)
2058 vinfo( 3)=
vname(3,idstcr)
2059 vinfo(14)=
vname(4,idstcr)
2060 vinfo(16)=
vname(1,idstcr)
2061# if defined WRITE_WATER && defined MASKING
2062 vinfo(20)=
'mask_rho'
2064 vinfo(21)=
vname(6,idstcr)
2065 vinfo(22)=
'coordinates'
2066 aval(5)=real(
iinfo(1,idstcr,ng),r8)
2067 s(ng)%pioVar(idstcr)%dkind=
pio_fout
2068 s(ng)%pioVar(idstcr)%gtype=
r2dvar
2070 status=
def_var(ng, model, s(ng)%pioFile, &
2071 & s(ng)%pioVar(idstcr)%vd, &
2072 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
2078 IF (varout(idsttr,ng))
THEN
2079 vinfo( 1)=
vname(1,idsttr)
2080 IF (s(ng)%ncid.eq.
avg(ng)%ncid)
THEN
2081 WRITE (vinfo( 2),
'(a,1x,a)') prefix, trim(
vname(2,idsttr))
2083 vinfo( 2)=
vname(2,idsttr)
2085 vinfo( 3)=
vname(3,idsttr)
2086 vinfo(14)=
vname(4,idsttr)
2087 vinfo(16)=
vname(1,idsttr)
2088# if defined WRITE_WATER && defined MASKING
2089 vinfo(20)=
'mask_rho'
2091 vinfo(21)=
vname(6,idsttr)
2092 vinfo(22)=
'coordinates'
2093 aval(5)=real(
iinfo(1,idsttr,ng),r8)
2094 s(ng)%pioVar(idsttr)%dkind=
pio_fout
2095 s(ng)%pioVar(idsttr)%gtype=
r2dvar
2097 status=
def_var(ng, model, s(ng)%pioFile, &
2098 & s(ng)%pioVar(idsttr)%vd, &
2099 &
pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
2111 query :
IF (.not.ldef)
THEN
2123 IF (trim(var_name(i)).eq.trim(
vname(1,
idtime)))
THEN
2127 s(ng)%pioVar(
idtime)%gtype=0
2128# if defined SEDIMENT && defined SED_MORPH
2129 ELSE IF (trim(var_name(i)).eq.trim(
vname(1,
idbath)))
THEN
2135# if defined SEDIMENT && defined BEDLOAD && defined BEDLOAD_VANDERA
2136 ELSE IF (trim(var_name(i)).eq.trim(
vname(1,idsurs)))
THEN
2137 got_var(idsurs)=.true.
2138 s(ng)%pioVar(idsurs)%vd=
var_desc(i)
2139 s(ng)%pioVar(idsurs)%dkind=
pio_fout
2140 s(ng)%pioVar(idsurs)%gtype=
r2dvar
2141 ELSE IF (trim(var_name(i)).eq.trim(
vname(1,idsrrw)))
THEN
2142 got_var(idsrrw)=.true.
2143 s(ng)%pioVar(idsrrw)%vd=
var_desc(i)
2144 s(ng)%pioVar(idsrrw)%dkind=
pio_fout
2145 s(ng)%pioVar(idsrrw)%gtype=
r2dvar
2146 ELSE IF (trim(var_name(i)).eq.trim(
vname(1,idsbtw)))
THEN
2147 got_var(idsbtw)=.true.
2148 s(ng)%pioVar(idsbtw)%vd=
var_desc(i)
2149 s(ng)%pioVar(idsbtw)%dkind=
pio_fout
2150 s(ng)%pioVar(idsbtw)%gtype=
r2dvar
2151 ELSE IF (trim(var_name(i)).eq.trim(
vname(1,idsucr)))
THEN
2152 got_var(idsucr)=.true.
2153 s(ng)%pioVar(idsucr)%vd=
var_desc(i)
2154 s(ng)%pioVar(idsucr)%dkind=
pio_fout
2155 s(ng)%pioVar(idsucr)%gtype=
r2dvar
2156 ELSE IF (trim(var_name(i)).eq.trim(
vname(1,idsutr)))
THEN
2157 got_var(idsutr)=.true.
2158 s(ng)%pioVar(idsutr)%vd=
var_desc(i)
2159 s(ng)%pioVar(idsutr)%dkind=
pio_fout
2160 s(ng)%pioVar(idsutr)%gtype=
r2dvar
2161 ELSE IF (trim(var_name(i)).eq.trim(
vname(1,idstcr)))
THEN
2162 got_var(idstcr)=.true.
2163 s(ng)%pioVar(idstcr)%vd=
var_desc(i)
2164 s(ng)%pioVar(idstcr)%dkind=
pio_fout
2165 s(ng)%pioVar(idstcr)%gtype=
r2dvar
2166 ELSE IF (trim(var_name(i)).eq.trim(
vname(1,idsttr)))
THEN
2167 got_var(idsttr)=.true.
2168 s(ng)%pioVar(idsttr)%vd=
var_desc(i)
2169 s(ng)%pioVar(idsttr)%dkind=
pio_fout
2170 s(ng)%pioVar(idsttr)%gtype=
r2dvar
2174 IF (trim(var_name(i)).eq. &
2176 got_var(
idfrac(itrc))=.true.
2180 ELSE IF (trim(var_name(i)).eq. &
2182 got_var(
idbmas(itrc))=.true.
2187 ELSE IF (trim(var_name(i)).eq. &
2189 got_var(
idubld(itrc))=.true.
2193 ELSE IF (trim(var_name(i)).eq. &
2195 got_var(
idvbld(itrc))=.true.
2203 IF (trim(var_name(i)).eq.trim(
vname(1,
idsbed(itrc))))
THEN
2204 got_var(
idsbed(itrc))=.true.
2211# if defined SEDIMENT || defined BBL_MODEL
2213 IF (trim(var_name(i)).eq.trim(
vname(1,
idbott(itrc))))
THEN
2214 got_var(
idbott(itrc))=.true.
2225 IF (.not.got_var(
idtime))
THEN
2231# if defined SEDIMENT && defined SED_MORPH
2239# if defined SEDIMENT && defined BEDLOAD && defined BEDLOAD_VANDERA
2240 IF (.not.got_var(idsurs).and.varout(idsurs,ng))
THEN
2246 IF (.not.got_var(idsrrw).and.varout(idsrrw,ng))
THEN
2252 IF (.not.got_var(idsbtw).and.varout(idsbtw,ng))
THEN
2258 IF (.not.got_var(idsucr).and.varout(idsucr,ng))
THEN
2264 IF (.not.got_var(idsutr).and.varout(idsutr,ng))
THEN
2270 IF (.not.got_var(idstcr).and.varout(idstcr,ng))
THEN
2276 IF (.not.got_var(idsttr).and.varout(idsttr,ng))
THEN
2285 IF (.not.got_var(
idfrac(i)).and.varout(
idfrac(i),ng))
THEN
2292 IF(.not.got_var(
idbmas(i)).and.varout(
idbmas(i),ng))
THEN
2299 IF (.not.got_var(
idubld(i)).and.varout(
idubld(i),ng))
THEN
2305 IF (.not.got_var(
idvbld(i)).and.varout(
idvbld(i),ng))
THEN
2314 IF (.not.got_var(
idsbed(i)).and.varout(
idsbed(i),ng))
THEN
2322# if defined SEDIMENT || defined BBL_MODEL
2324 IF (.not.got_var(
idbott(i)).and.varout(
idbott(i),ng))
THEN
2334 10
FORMAT (1pe11.4,1x,
'millimeter')
2335 20
FORMAT (/,
' SEDIMENT_DEF_PIO - unable to find variable: ', &
2336 & a,2x,
' in output NetCDF file: ',a)
2343 & LBi, UBi, LBj, UBj, &
2351 logical,
intent(in) :: varout(
nv,
ngrids)
2353 integer,
intent(in) :: ng, model, tile
2354 integer,
intent(in) :: lbi, ubi, lbj, ubj
2360 logical :: linstataneous
2366 character (len=*),
parameter :: myfile = &
2367 & __FILE__//
", sediment_wrt_pio"
2369 TYPE (io_desc_t),
pointer :: iodesc
2381 IF ((s(ng)%ncid.eq.s(ng)%ncid).or. &
2382 & (s(ng)%ncid.eq.
qck(ng)%ncid))
THEN
2383 linstataneous=.true.
2385 linstataneous=.false.
2388# if defined SEDIMENT && defined SED_MORPH
2392 IF (varout(
idbath,ng))
THEN
2394 IF (s(ng)%pioVar(
idbath)%dkind.eq.pio_double)
THEN
2400 & s(ng)%pioVar(
idbath), &
2403 & lbi, ubi, lbj, ubj, scale, &
2405 &
grid(ng) % rmask, &
2408 & setfillval = .false.)
2409 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2420# if defined SEDIMENT && bedload BEDLOAD
2425 IF (varout(
idubld(i),ng))
THEN
2427 IF (s(ng)%pioVar(
idubld(i))%dkind.eq.pio_double)
THEN
2432 IF (linstataneous)
THEN
2434 & s(ng)%pioVar(
idubld(i)), &
2437 & lbi, ubi, lbj, ubj, scale, &
2439 &
grid(ng) % umask, &
2441 &
sedbed(ng) % bedldu(:,:,i))
2445 & s(ng)%pioVar(
idubld(i)), &
2448 & lbi, ubi, lbj, ubj, scale, &
2450 &
grid(ng) % umask, &
2452 &
sedbed(ng) % avgbedldu(:,:,i))
2455 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2467 IF (varout(
idvbld(i),ng))
THEN
2469 IF (s(ng)%pioVar(
idvbld(i))%dkind.eq.pio_double)
THEN
2474 IF (linstataneous)
THEN
2476 & s(ng)%pioVar(
idvbld(i)), &
2479 & lbi, ubi, lbj, ubj, scale, &
2481 &
grid(ng) % vmask, &
2483 &
sedbed(ng) % bedldv(:,:,i))
2487 & s(ng)%pioVar(
idvbld(i)), &
2490 & lbi, ubi, lbj, ubj, scale, &
2492 &
grid(ng) % vmask, &
2494 &
sedbed(ng) % avgbedldv(:,:,i))
2497 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2514 IF (varout(
idfrac(i),ng))
THEN
2516 IF (s(ng)%pioVar(
idfrac(i))%dkind.eq.pio_double)
THEN
2522 & s(ng)%pioVar(
idfrac(i)), &
2525 & lbi, ubi, lbj, ubj, 1,
nbed, scale, &
2527 &
grid(ng) % rmask, &
2529 &
sedbed(ng) % bed_frac(:,:,:,i))
2530 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2544 IF (varout(
idbmas(i),ng))
THEN
2546 IF (s(ng)%pioVar(
idbmas(i))%dkind.eq.pio_double)
THEN
2552 & s(ng)%pioVar(
idbmas(i)), &
2555 & lbi, ubi, lbj, ubj, 1,
nbed, scale, &
2557 &
grid(ng) % rmask, &
2559 &
sedbed(ng) % bed_mass(:,:,:,nout,i))
2560 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2574 IF (varout(
idsbed(i),ng))
THEN
2576 IF (s(ng)%pioVar(
idsbed(i))%dkind.eq.pio_double)
THEN
2582 & s(ng)%pioVar(
idsbed(i)), &
2585 & lbi, ubi, lbj, ubj, 1,
nbed, scale, &
2587 &
grid(ng) % rmask, &
2589 &
sedbed(ng) % bed(:,:,:,i))
2590 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2602# if defined SEDIMENT || defined BBL_MODEL
2607 IF (varout(
idbott(i),ng))
THEN
2608 IF (i.eq.
itauc)
THEN
2613 IF (s(ng)%pioVar(
idbott(i))%dkind.eq.pio_double)
THEN
2619 & s(ng)%pioVar(
idbott(i)), &
2622 & lbi, ubi, lbj, ubj, scale, &
2624 &
grid(ng) % rmask, &
2626 &
sedbed(ng) % bottom(:,:,i))
2627 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2639# if defined SEDIMENT && defined BEDLOAD && defined SED_BEDLOAD_VANDERA
2643 IF (varout(idsurs,ng))
THEN
2645 IF (s(ng)%pioVar(idsurs)%dkind.eq.pio_double)
THEN
2650 status=
nf_fwrite2d(ng, model, s(ng)%pioFile, idsurs, &
2651 & s(ng)%pioVar(idsurs), &
2654 & lbi, ubi, lbj, ubj, scale, &
2656 &
grid(ng) % rmask, &
2658 &
sedbed(ng) % ursell_no)
2659 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2661 WRITE (
stdout,10) trim(
vname(1,idsurs)), s(ng)%Rindex
2671 IF (varout(idsrrw,ng))
THEN
2673 IF (s(ng)%pioVar(idsrrw)%dkind.eq.pio_double)
THEN
2678 status=
nf_fwrite2d(ng, model, s(ng)%pioFile, idsrrw, &
2679 & s(ng)%pioVar(idsrrw), &
2682 & lbi, ubi, lbj, ubj, scale, &
2684 &
grid(ng) % rmask, &
2686 &
sedbed(ng) % RR_asymwave)
2687 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2689 WRITE (
stdout,10) trim(
vname(1,idsrrw)), s(ng)%Rindex
2699 IF (varout(idsbtw,ng))
THEN
2701 IF (s(ng)%pioVar(idsbtw)%dkind.eq.pio_double)
THEN
2706 status=
nf_fwrite2d(ng, model, s(ng)%pioFile, idsbtw, &
2707 & s(ng)%pioVar(idsbtw), &
2710 & lbi, ubi, lbj, ubj, scale, &
2712 &
grid(ng) % rmask, &
2714 &
sedbed(ng) % beta_asymwave)
2715 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2717 WRITE (
stdout,10) trim(
vname(1,idsbtw)), s(ng)%Rindex
2727 IF (varout(idsucr,ng))
THEN
2729 IF (s(ng)%pioVar(idsucr)%dkind.eq.pio_double)
THEN
2734 status=
nf_fwrite2d(ng, model, s(ng)%pioFile, idsucr, &
2735 & s(ng)%pioVar(idsucr), &
2738 & lbi, ubi, lbj, ubj, scale, &
2740 &
grid(ng) % rmask, &
2743 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2745 WRITE (
stdout,10) trim(
vname(1,idsucr)), s(ng)%Rindex
2755 IF (varout(idsutr,ng))
THEN
2757 IF (s(ng)%pioVar(idsutr)%dkind.eq.pio_double)
THEN
2762 status=
nf_fwrite2d(ng, model, s(ng)%pioFile, idsutr, &
2763 & s(ng)%pioVar(idsutr), &
2766 & lbi, ubi, lbj, ubj, scale, &
2768 &
grid(ng) % rmask, &
2770 &
sedbed(ng) % utrough_r)
2771 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2773 WRITE (
stdout,10) trim(
vname(1,idsutr)), s(ng)%Rindex
2783 IF (varout(idstcr,ng))
THEN
2785 IF (s(ng)%pioVar(idstcr)%dkind.eq.pio_double)
THEN
2790 status=
nf_fwrite2d(ng, model, s(ng)%pioFile, idstcr, &
2791 & s(ng)%pioVar(idstcr), &
2794 & lbi, ubi, lbj, ubj, scale, &
2796 &
grid(ng) % rmask, &
2799 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2801 WRITE (
stdout,10) trim(
vname(1,idstcr)), s(ng)%Rindex
2811 IF (varout(idsttr,ng))
THEN
2813 IF (s(ng)%pioVar(idsttr)%dkind.eq.pio_double)
THEN
2818 status=
nf_fwrite2d(ng, model, s(ng)%pioFile, idsttr, &
2819 & s(ng)%pioVar(idsttr), &
2822 & lbi, ubi, lbj, ubj, scale, &
2824 &
grid(ng) % rmask, &
2827 IF (
founderror(status, pio_noerr, __line__, myfile))
THEN
2829 WRITE (
stdout,10) trim(
vname(1,idsttr)), s(ng)%Rindex
2838 10
FORMAT (/,
" SEDIMENT_WRT_PIO - error while writing variable '", &
2839 & a,
"', time record = ",i0,/,11x,
'into file: ',a)
2855 logical,
intent(in) :: ldef, varout(
nv,
ngrids)
2857 integer,
intent(in) :: ng, model
2858 integer,
intent(in),
optional :: bgrd(:), pgrd(:), rgrd(:)
2864 logical :: got_var(
nv)
2866 integer,
parameter :: natt = 25
2868 integer :: i, itrc, j, status
2872 character (len=120) :: vinfo(natt)
2873 character (len=256) :: ncname
2875 character (len=*),
parameter :: myfile = &
2876 & __FILE__//
", sediment_def_station_nf90"
2887 define :
IF (ldef)
THEN
2892 DO j=1,len(vinfo(1))
2900# if defined SEDIMENT && defined SED_MORPH
2904 IF (varout(
idbath,ng))
THEN
2910 s(ng)%pioVar(
idbath)%dkind=pio_fout
2911 s(ng)%pioVar(
idbath)%gtype=0
2913 status=
def_var(ng, model, s(ng)%pioFile, &
2914 & s(ng)%pioVar(
idbath)%vd, &
2915 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
2916 & setfillval = .false., &
2917 & setparaccess = .true.)
2927 IF (varout(
idfrac(i),ng))
THEN
2933 WRITE (vinfo(19),10) 1000.0_r8*
sd50(i,ng)
2934 s(ng)%pioVar(
idfrac(i))%dkind=pio_fout
2935 s(ng)%pioVar(
idfrac(i))%gtype=0
2937 status=
def_var(ng, model, s(ng)%pioFile, &
2938 & s(ng)%pioVar(
idfrac(i))%vd, &
2939 & pio_fout, 3, bgrd, aval, vinfo, ncname, &
2940 & setfillval = .true., &
2941 & setparaccess = .true.)
2947 IF (varout(
idbmas(i),ng))
THEN
2953 WRITE (vinfo(19),10) 1000.0_r8*
sd50(i,ng)
2954 s(ng)%pioVar(
idbmas(i))%dkind=pio_fout
2955 s(ng)%pioVar(
idbmas(i))%gtype=0
2957 status=
def_var(ng, model, s(ng)%pioFile, &
2958 & s(ng)%pioVar(
idbmas(i))%vd, &
2959 & pio_fout, 3, bgrd, aval, vinfo, ncname, &
2960 & setfillval = .true., &
2961 & setparaccess = .true.)
2969 IF (varout(
idsbed(i),ng))
THEN
2975 s(ng)%pioVar(
idsbed(i))%dkind=pio_fout
2976 s(ng)%pioVar(
idsbed(i))%gtype=0
2978 status=
def_var(ng, model, s(ng)%pioFile, &
2979 & s(ng)%pioVar(
idsbed(i))%vd, &
2980 & pio_fout, 3, bgrd, aval, vinfo, ncname, &
2981 & setfillval = .true., &
2982 & setparaccess = .true.)
2988# if defined SEDIMENT || defined BBL_MODEL
2993 IF (varout(
idbott(i),ng))
THEN
2999 s(ng)%pioVar(
idbott(i))%dkind=pio_fout
3000 s(ng)%pioVar(
idbott(i))%gtype=0
3002 status=
def_var(ng, model, s(ng)%pioFile, &
3003 & s(ng)%pioVar(
idbott(i))%vd, &
3004 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
3005 & setfillval = .true., &
3006 & setparaccess = .true.)
3019 query :
IF (.not.ldef)
THEN
3033 s(ng)%pioVar(
idtime)%vd=var_desc(i)
3034 s(ng)%pioVar(
idtime)%dkind=pio_tout
3035 s(ng)%pioVar(
idtime)%gtype=0
3036# if defined SEDIMENT && defined SED_MORPH
3039 s(ng)%pioVar(
idbath)%vd=var_desc(i)
3040 s(ng)%pioVar(
idbath)%dkind=pio_fout
3041 s(ng)%pioVar(
idbath)%gtype=0
3047 got_var(
idfrac(itrc))=.true.
3048 s(ng)%pioVar(
idfrac(itrc))%vd=var_desc(i)
3049 s(ng)%pioVar(
idfrac(itrc))%dkind=pio_fout
3050 s(ng)%pioVar(
idfrac(itrc))%gtype=0
3053 got_var(
idbmas(itrc))=.true.
3054 s(ng)%pioVar(
idbmas(itrc))%vd=var_desc(i)
3055 s(ng)%pioVar(
idbmas(itrc))%dkind=pio_fout
3056 s(ng)%pioVar(
idbmas(itrc))%gtype=0
3061 got_var(
idsbed(itrc))=.true.
3062 s(ng)%pioVar(
idsbed(itrc))%vd=var_desc(i)
3063 s(ng)%pioVar(
idsbed(itrc))%dkind=pio_fout
3064 s(ng)%pioVar(
idsbed(itrc))%gtype=0
3068# if defined SEDIMENT || defined BBL_MODEL
3071 got_var(
idbott(itrc))=.true.
3072 s(ng)%pioVar(
idbott(itrc))%vd=var_desc(i)
3073 s(ng)%pioVar(
idbott(itrc))%dkind=pio_fout
3074 s(ng)%pioVar(
idbott(itrc))%gtype=0
3082 IF (.not.got_var(
idtime))
THEN
3088# if defined SEDIMENT && defined SED_MORPH
3098 IF (.not.got_var(
idfrac(i)).and.varout(
idfrac(i),ng))
THEN
3104 IF (.not.got_var(
idbmas(i)).and.varout(
idbmas(i),ng))
THEN
3112 IF (.not.got_var(
idsbed(i)).and.varout(
idsbed(i),ng))
THEN
3120# if defined SEDIMENT || defined BBL_MODEL
3122 IF (.not.got_var(
idbott(i)).and.varout(
idbott(i),ng))
THEN
3131 10
FORMAT (1pe11.4,1x,
'millimeter')
3132 20
FORMAT (/,
' SEDIMENT_DEF_STATION_PIO - unable to find variable:', &
3133 & 1x,a,2x,
' in stations NetCDF file: ',a)
3140 & LBi, UBi, LBj, UBj, &
3148 logical,
intent(in) :: varout(
nv,
ngrids)
3150 integer,
intent(in) :: ng, model, tile
3151 integer,
intent(in) :: lbi, ubi, lbj, ubj
3160 integer :: i, k, np, status
3164 real(r8),
dimension(Nstation(ng)) :: xpos, ypos, zpos, psta
3167 real(r8),
dimension(Nstation(ng)*Nbed) :: xposb, yposb, zposb
3168 real(r8),
dimension(Nstation(ng)*Nbed) :: bsta
3171 character (len=*),
parameter :: myfile = &
3172 & __FILE__//
", sediment_wrt_station_pio"
3186# ifdef STATIONS_CGRID
3202 xposb(np)=
scalars(ng)%SposX(i)
3203 yposb(np)=
scalars(ng)%SposY(i)
3204 zposb(np)=real(k,r8)
3209# if defined SEDIMENT && defined SED_MORPH
3213 IF (varout(
idbath,ng))
THEN
3216 & lbi, ubi, lbj, ubj, &
3217 & scale,
grid(ng)%h, &
3221 & (/1,s(ng)%Rindex/), &
3223 & piofile = s(ng)%pioFile, &
3224 & piovar = s(ng)%pioVar(
idbath)%vd)
3234 IF (varout(
idfrac(i),ng))
THEN
3237 & lbi, ubi, lbj, ubj, 1,
nbed, &
3238 & scale,
sedbed(ng)%bed_frac(:,:,:,i), &
3239 & nposb, xposb, yposb, zposb, bsta)
3242 & (/1,1,s(ng)%Rindex/), &
3244 & piofile = s(ng)%pioFile, &
3245 & piovar = s(ng)%pioVar(
idfrac(i))%vd)
3251 IF (varout(
idbmas(i),ng))
THEN
3254 & lbi, ubi, lbj, ubj, 1,
nbed, &
3256 &
sedbed(ng)%bed_mass(:,:,:,nout,i), &
3257 & nposb, xposb, yposb, zposb, bsta)
3260 & (/1,1,s(ng)%Rindex/), &
3262 & piofile = s(ng)%pioFile, &
3263 & piovar = s(ng)%pioVar(
idbmas(i))%vd)
3271 IF (varout(
idsbed(i),ng))
THEN
3274 & lbi, ubi, lbj, ubj, 1,
nbed, &
3275 & scale,
sedbed(ng)%bed(:,:,:,i), &
3276 & nposb, xposb, yposb, zposb, bsta)
3279 & (/1,1,s(ng)%Rindex/), &
3281 & piofile = s(ng)%pioFile, &
3282 & piovar = s(ng)%pioVar(
idsbed(i))%vd)
3288# if defined SEDIMENT || defined BBL_MODEL
3293 IF (varout(
idbott(i),ng))
THEN
3296 & lbi, ubi, lbj, ubj, &
3297 & scale,
sedbed(ng)%bottom(:,:,i), &
3301 & (/1,s(ng)%Rindex/), &
3303 & piofile = s(ng)%pioFile, &
3304 & piovar = s(ng)%pioVar(
idbott(i))%vd)