57 CHARACTER(LEN=100),
INTENT(IN) :: INFILE
60 INTEGER :: N_ELEMS,N_NODES,N_SIG_M1,N_SIG
61 REAL(SP),
ALLOCATABLE,
DIMENSION(:,:) :: TEMP
65 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
66 IF(ierr /=nf90_noerr)
THEN 67 WRITE(*,*)
'ERROR READING ',trim(infile)
68 WRITE(*,*)trim(nf90_strerror(ierr))
105 CHARACTER(LEN=100),
INTENT(IN) :: INFILE
109 REAL(SP),
ALLOCATABLE,
DIMENSION(:,:) :: TEMP
112 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
113 IF(ierr /=nf90_noerr)
THEN 114 WRITE(*,*)
'ERROR READING ',trim(infile)
115 WRITE(*,*)trim(nf90_strerror(ierr))
122 vx(1:m) = temp(1:m,1)
123 WHERE(
vx < 0.0_sp)
vx=360.0_sp+
vx 128 vy(1:m) = temp(1:m,1)
134 nv(1:n,1:3) = temp(1:n,1:3)
147 z(1:m,1:kb) = temp(1:m,1:kb)
152 zz(:,k)=0.5_sp*(
z(:,k)+
z(:,k+1))
153 dz(:,k)=
z(:,k)-
z(:,k+1)
155 zz(:,kb)=2.0_sp*
zz(:,kbm1)-
zz(:,kbm2)
164 z1(i,:) = (
z(
nv(i,1),:)+
z(
nv(i,2),:)+
z(
nv(i,3),:))/3.0
172 a1u(1:n,:) = temp(1:n,:)
177 a2u(1:n,:) = temp(1:n,:)
182 aw0(1:n,:) = temp(1:n,:)
187 awx(1:n,:) = temp(1:n,:)
192 awy(1:n,:) = temp(1:n,:)
211 REAL(DP),
INTENT(IN) :: time
212 INTEGER,
INTENT(OUT) :: HO
213 CHARACTER(LEN=*),
INTENT(IN) :: INFILE
217 REAL(DP),
ALLOCATABLE,
DIMENSION(:,:) :: TEMP,TEMP2
219 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
220 IF(ierr /=nf90_noerr)
THEN 221 WRITE(*,*)
'ERROR READING ',trim(infile)
222 WRITE(*,*)trim(nf90_strerror(ierr))
223 WRITE(*,*)
' Second Try' 224 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
225 IF(ierr /=nf90_noerr)
THEN 226 WRITE(*,*)
' 2nd ERROR READING ',trim(infile)
227 WRITE(*,*)trim(nf90_strerror(ierr))
228 WRITE(*,*)
' Third Try' 229 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
230 IF(ierr /=nf90_noerr)
THEN 231 WRITE(*,*)
' 3rd ERROR READING ',trim(infile)
232 WRITE(*,*)trim(nf90_strerror(ierr))
233 WRITE(*,*)
' Yer Out!' 243 ALLOCATE(temp(n_times,1))
248 if (abs(temp(i,1)-time)<1e-6)
then 250 print *,
"FIND THE DATA INDEX MATCHING CURRENT TIME STEP :", ho+1 , temp(ho+1,1)
257 print *,
'dont find the nc index match current time:', time
273 REAL(SP),
DIMENSION(0:NGL,KB),
INTENT(OUT) :: UL,VL
274 REAL(SP),
DIMENSION(0:MGL,KB),
INTENT(OUT) :: T1L,S1L
276 REAL(SP),
DIMENSION(0:MGL),
INTENT(OUT) :: ELL
278 INTEGER,
INTENT(IN) :: HO
279 CHARACTER(LEN=*),
INTENT(IN) :: INFILE
283 REAL(SP),
ALLOCATABLE,
DIMENSION(:,:) :: TEMP,TEMP2
293 print *,
'nc read from:', infile,
" in hour: ",ht
298 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
299 IF(ierr /=nf90_noerr)
THEN 300 WRITE(*,*)
'ERROR READING ',trim(infile)
301 WRITE(*,*)trim(nf90_strerror(ierr))
302 WRITE(*,*)
' Second Try' 303 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
304 IF(ierr /=nf90_noerr)
THEN 305 WRITE(*,*)
' 2nd ERROR READING ',trim(infile)
306 WRITE(*,*)trim(nf90_strerror(ierr))
307 WRITE(*,*)
' Third Try' 308 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
309 IF(ierr /=nf90_noerr)
THEN 310 WRITE(*,*)
' 3rd ERROR READING ',trim(infile)
311 WRITE(*,*)trim(nf90_strerror(ierr))
312 WRITE(*,*)
' Yer Out!' 335 print *,
'finish open nc file' 336 ALLOCATE(temp(
mgl,1))
338 ell(1:
mgl) = temp(1:
mgl,1)
340 print *,
'finish reading el' 346 print *,
'finish reading salinity' 352 print *,
'finish reading temp' 359 print *,
'finish reading u' 365 print *,
'finish reading v' 406 SUBROUTINE ncd_read(INFILE,UL,VL,WWL,KHL,ELL,time,HO)
417 REAL(SP),
DIMENSION(0:N,KB),
INTENT(OUT) :: UL,VL,WWL
418 REAL(SP),
DIMENSION(0:M,KB),
INTENT(OUT) :: KHL
420 REAL(SP),
DIMENSION(0:M),
INTENT(OUT) :: ELL
421 REAL(SP),
INTENT(OUT) :: time
422 INTEGER,
INTENT(IN) :: HO
423 CHARACTER(LEN=100),
INTENT(IN) :: INFILE
427 REAL(SP),
ALLOCATABLE,
DIMENSION(:,:) :: TEMP,TEMP2
433 print *,
'nc read from:', infile,
"in hour: ",ht
438 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
439 IF(ierr /=nf90_noerr)
THEN 440 WRITE(*,*)
'ERROR READING ',trim(infile)
441 WRITE(*,*)trim(nf90_strerror(ierr))
442 WRITE(*,*)
' Second Try' 443 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
444 IF(ierr /=nf90_noerr)
THEN 445 WRITE(*,*)
' 2nd ERROR READING ',trim(infile)
446 WRITE(*,*)trim(nf90_strerror(ierr))
447 WRITE(*,*)
' Third Try' 448 ierr = nf90_open(trim(infile),nf90_nowrite,
nc_fid)
449 IF(ierr /=nf90_noerr)
THEN 450 WRITE(*,*)
' 3rd ERROR READING ',trim(infile)
451 WRITE(*,*)trim(nf90_strerror(ierr))
452 WRITE(*,*)
' Yer Out!' 477 ell(1:
m) = temp(1:
m,1)
494 ALLOCATE(temp(
n,
kbm1))
500 ALLOCATE(temp(
n,
kbm1))
511 ALLOCATE(temp(
m,
kbm1))
512 ALLOCATE(temp2(
n,
kbm1))
513 print *,
'do not read omega, set to zero:' 518 temp2(i,:) = ((temp(
nv(i,1),:))+(temp(
nv(i,2),:))+(temp(
nv(i,3),:)))/3.0
521 DEALLOCATE(temp,temp2)
524 ALLOCATE(temp(
m,
kbm1))
525 print *,
'do not read km, set to zero' 550 INTEGER,
INTENT(IN) :: nnode,nlayer
551 CHARACTER(LEN=120),
INTENT(IN) :: INFILE
552 CHARACTER(LEN=100) :: varname
553 CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
554 INTEGER :: IERR,varid
555 INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
556 INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
557 INTEGER :: DYNMTIME(1)
558 INTEGER :: STAT1D(1),DYNM1D(2)
559 REAL(SP),
DIMENSION(nnode,nlayer) :: TEMP
560 integer :: RecordDimID
563 character(len = nf90_max_name) :: RecordDimName
567 ierr = nf90_open(trim(infile),nf90_write,
nc_fid)
568 IF(ierr /=nf90_noerr)
THEN 569 WRITE(*,*)
'ERROR OPENING ',trim(infile)
570 WRITE(*,*)trim(nf90_strerror(ierr))
573 ierr = nf90_inquire(
nc_fid, unlimiteddimid = recorddimid)
574 IF(ierr /=nf90_noerr)
THEN 575 WRITE(*,*)
'error inquire unlimited id for el: ' 576 WRITE(*,*)trim(nf90_strerror(ierr))
579 ierr = nf90_inquire_dimension(
nc_fid, recorddimid, &
580 name = recorddimname, len = nrecords)
581 IF(ierr /=nf90_noerr)
THEN 582 WRITE(*,*)
'error inquire length of unlimited id for el: ' 583 WRITE(*,*)trim(nf90_strerror(ierr))
586 print *,
"length of unlimited dimension are : ",nrecords
593 ierr = nf90_inq_varid(
nc_fid,trim(varname),varid)
594 IF(ierr /=nf90_noerr)
THEN 595 WRITE(*,*)
'error getting variable id: ',trim(varname)
596 WRITE(*,*)trim(nf90_strerror(ierr))
600 ierr = nf90_put_var(
nc_fid,varid,temp,start=dims)
601 IF(ierr /=nf90_noerr)
THEN 602 WRITE(*,*)
'3 error getting variable: ',trim(varname)
604 WRITE(*,*)trim(nf90_strerror(ierr))
614 INTEGER,
INTENT(IN) :: ncell,nlayer
615 CHARACTER(LEN=120),
INTENT(IN) :: INFILE
616 CHARACTER(LEN=100) :: varname
617 CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
618 INTEGER :: IERR,VARID
619 INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
620 INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
621 INTEGER :: DYNMTIME(1)
622 INTEGER :: STAT1D(1),DYNM1D(2)
623 REAL(SP),
DIMENSION(ncell,nlayer) :: TEMP
624 REAL(SP),
DIMENSION(ncell,nlayer,1) :: TEMP3
625 integer :: RecordDimID
628 character(len = nf90_max_name) :: RecordDimName
631 print *,
'open nc file in write u: ',trim(infile)
632 ierr = nf90_open(trim(infile),nf90_write,
nc_fid)
633 IF(ierr /=nf90_noerr)
THEN 634 WRITE(*,*)
'ERROR OPENING ',trim(infile)
635 WRITE(*,*)trim(nf90_strerror(ierr))
638 ierr = nf90_inquire(
nc_fid, unlimiteddimid = recorddimid)
639 IF(ierr /=nf90_noerr)
THEN 640 WRITE(*,*)
'error inquire unlimited id for u: ' 641 WRITE(*,*)trim(nf90_strerror(ierr))
644 ierr = nf90_inquire_dimension(
nc_fid, recorddimid, &
645 name = recorddimname, len = nrecords)
646 IF(ierr /=nf90_noerr)
THEN 647 WRITE(*,*)
'error inquire length of unlimited id for u: ' 648 WRITE(*,*)trim(nf90_strerror(ierr))
651 print *,
"length of unlimited dimension are : ",nrecords
658 ierr = nf90_inq_varid(
nc_fid,trim(varname),varid)
659 IF(ierr /=nf90_noerr)
THEN 660 WRITE(*,*)
'error getting variable id: ',trim(varname)
661 WRITE(*,*)trim(nf90_strerror(ierr))
665 ierr = nf90_put_var(
nc_fid,varid,temp,start=dims)
666 IF(ierr /=nf90_noerr)
THEN 667 WRITE(*,*)
'3 error getting variable: ',trim(varname)
669 WRITE(*,*)trim(nf90_strerror(ierr))
683 INTEGER,
INTENT(IN) :: ncell,nlayer
684 CHARACTER(LEN=120),
INTENT(IN) :: INFILE
685 CHARACTER(LEN=100) :: varname
686 CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
687 INTEGER :: IERR,VARID
688 INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
689 INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
690 INTEGER :: DYNMTIME(1)
691 INTEGER :: STAT1D(1),DYNM1D(2)
692 REAL(SP),
DIMENSION(ncell,nlayer) :: TEMP
693 integer :: RecordDimID
696 character(len = nf90_max_name) :: RecordDimName
699 ierr = nf90_open(trim(infile),nf90_write,
nc_fid)
700 IF(ierr /=nf90_noerr)
THEN 701 WRITE(*,*)
'ERROR OPENING ',trim(infile)
702 WRITE(*,*)trim(nf90_strerror(ierr))
708 ierr = nf90_inq_varid(
nc_fid,trim(varname),varid)
709 IF(ierr /=nf90_noerr)
THEN 710 WRITE(*,*)
'error getting variable id: ',trim(varname)
711 WRITE(*,*)trim(nf90_strerror(ierr))
714 ierr = nf90_inquire(
nc_fid, unlimiteddimid = recorddimid)
715 IF(ierr /=nf90_noerr)
THEN 716 WRITE(*,*)
'error inquire unlimited id for v: ' 717 WRITE(*,*)trim(nf90_strerror(ierr))
720 ierr = nf90_inquire_dimension(
nc_fid, recorddimid, &
721 name = recorddimname, len = nrecords)
722 IF(ierr /=nf90_noerr)
THEN 723 WRITE(*,*)
'error inquire length of unlimited id for v: ' 724 WRITE(*,*)trim(nf90_strerror(ierr))
727 print *,
"length of unlimited dimension are : ",nrecords
732 ierr = nf90_put_var(
nc_fid,varid,temp,start=dims)
733 IF(ierr /=nf90_noerr)
THEN 734 WRITE(*,*)
'3 error getting variable: ',trim(varname)
736 WRITE(*,*)trim(nf90_strerror(ierr))
751 INTEGER,
INTENT(IN) :: ncell,nlayer
752 CHARACTER(LEN=120),
INTENT(IN) :: INFILE
753 CHARACTER(LEN=100) :: varname
754 CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
755 INTEGER :: IERR,VARID
756 INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
757 INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
758 INTEGER :: DYNMTIME(1)
759 INTEGER :: STAT1D(1),DYNM1D(2)
760 REAL(SP),
DIMENSION(ncell,nlayer) :: TEMP
761 REAL(SP),
DIMENSION(ncell,nlayer,1) :: TEMP3
763 integer :: RecordDimID
765 integer :: dims(3),cnts(3)
766 character(len = nf90_max_name) :: RecordDimName
770 print *,
'open nc file in write u: ',trim(infile)
771 ierr = nf90_open(trim(infile),nf90_write,
nc_fid)
772 IF(ierr /=nf90_noerr)
THEN 773 WRITE(*,*)
'ERROR OPENING ',trim(infile)
774 WRITE(*,*)trim(nf90_strerror(ierr))
777 ierr = nf90_inquire(
nc_fid, unlimiteddimid = recorddimid)
778 IF(ierr /=nf90_noerr)
THEN 779 WRITE(*,*)
'error inquire unlimited id for u: ' 780 WRITE(*,*)trim(nf90_strerror(ierr))
783 ierr = nf90_inquire_dimension(
nc_fid, recorddimid, &
784 name = recorddimname, len = nrecords)
785 IF(ierr /=nf90_noerr)
THEN 786 WRITE(*,*)
'error inquire length of unlimited id for u: ' 787 WRITE(*,*)trim(nf90_strerror(ierr))
790 print *,
"length of unlimited dimension are : ",nrecords
800 ierr = nf90_inq_varid(
nc_fid,trim(varname),varid)
801 IF(ierr /=nf90_noerr)
THEN 802 WRITE(*,*)
'error getting variable id: ',trim(varname)
803 WRITE(*,*)trim(nf90_strerror(ierr))
807 ierr = nf90_put_var(
nc_fid,varid,temp(:,1:num),start=dims,count=cnts)
808 IF(ierr /=nf90_noerr)
THEN 809 WRITE(*,*)
'3 error getting variable: ',trim(varname)
811 WRITE(*,*)trim(nf90_strerror(ierr))
825 INTEGER,
INTENT(IN) :: ncell,nlayer
826 CHARACTER(LEN=120),
INTENT(IN) :: INFILE
827 CHARACTER(LEN=100) :: varname
828 CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
829 INTEGER :: IERR,VARID
830 INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
831 INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
832 INTEGER :: DYNMTIME(1)
833 INTEGER :: STAT1D(1),DYNM1D(2)
834 REAL(SP),
DIMENSION(ncell,nlayer) :: TEMP
836 integer :: RecordDimID
838 integer :: dims(3),cnts(3)
839 character(len = nf90_max_name) :: RecordDimName
842 ierr = nf90_open(trim(infile),nf90_write,
nc_fid)
843 IF(ierr /=nf90_noerr)
THEN 844 WRITE(*,*)
'ERROR OPENING ',trim(infile)
845 WRITE(*,*)trim(nf90_strerror(ierr))
851 ierr = nf90_inq_varid(
nc_fid,trim(varname),varid)
852 IF(ierr /=nf90_noerr)
THEN 853 WRITE(*,*)
'error getting variable id: ',trim(varname)
854 WRITE(*,*)trim(nf90_strerror(ierr))
857 ierr = nf90_inquire(
nc_fid, unlimiteddimid = recorddimid)
858 IF(ierr /=nf90_noerr)
THEN 859 WRITE(*,*)
'error inquire unlimited id for v: ' 860 WRITE(*,*)trim(nf90_strerror(ierr))
863 ierr = nf90_inquire_dimension(
nc_fid, recorddimid, &
864 name = recorddimname, len = nrecords)
865 IF(ierr /=nf90_noerr)
THEN 866 WRITE(*,*)
'error inquire length of unlimited id for v: ' 867 WRITE(*,*)trim(nf90_strerror(ierr))
870 print *,
"length of unlimited dimension are : ",nrecords
878 ierr = nf90_put_var(
nc_fid,varid,temp(:,1:num),start=dims,count=cnts)
879 IF(ierr /=nf90_noerr)
THEN 880 WRITE(*,*)
'3 error getting variable: ',trim(varname)
882 WRITE(*,*)trim(nf90_strerror(ierr))
898 INTEGER,
INTENT(IN) :: nnode,nlayer
899 CHARACTER(LEN=120),
INTENT(IN) :: INFILE
900 CHARACTER(LEN=100) :: varname
901 CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
902 INTEGER :: IERR,VARID
903 INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
904 INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
905 INTEGER :: DYNMTIME(1)
906 INTEGER :: STAT1D(1),DYNM1D(2)
907 REAL(SP),
DIMENSION(nnode,nlayer) :: TEMP
908 integer :: RecordDimID
911 character(len = nf90_max_name) :: RecordDimName
915 ierr = nf90_open(trim(infile),nf90_write,
nc_fid)
916 IF(ierr /=nf90_noerr)
THEN 917 WRITE(*,*)
'ERROR OPENING ',trim(infile)
918 WRITE(*,*)trim(nf90_strerror(ierr))
924 ierr = nf90_inq_varid(
nc_fid,trim(varname),varid)
925 IF(ierr /=nf90_noerr)
THEN 926 WRITE(*,*)
'error getting variable id: ',trim(varname)
927 WRITE(*,*)trim(nf90_strerror(ierr))
930 ierr = nf90_inquire(
nc_fid, unlimiteddimid = recorddimid)
931 IF(ierr /=nf90_noerr)
THEN 932 WRITE(*,*)
'error inquire unlimited id for t: ' 933 WRITE(*,*)trim(nf90_strerror(ierr))
936 ierr = nf90_inquire_dimension(
nc_fid, recorddimid, &
937 name = recorddimname, len = nrecords)
938 IF(ierr /=nf90_noerr)
THEN 939 WRITE(*,*)
'error inquire length of unlimited id for t: ' 940 WRITE(*,*)trim(nf90_strerror(ierr))
943 print *,
"length of unlimited dimension are : ",nrecords
947 ierr = nf90_put_var(
nc_fid,varid,temp,start=dims)
948 IF(ierr /=nf90_noerr)
THEN 949 WRITE(*,*)
'3 error getting variable: ',trim(varname)
951 WRITE(*,*)trim(nf90_strerror(ierr))
962 INTEGER,
INTENT(IN) ::nnode,nlayer
963 CHARACTER(LEN=120),
INTENT(IN) :: INFILE
964 CHARACTER(LEN=100) :: varname
965 CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
966 INTEGER :: IERR,VARID
967 INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
968 INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
969 INTEGER :: DYNMTIME(1)
970 INTEGER :: STAT1D(1),DYNM1D(2)
971 REAL(SP),
DIMENSION(nnode,nlayer) :: TEMP
972 integer :: RecordDimID
975 character(len = nf90_max_name) :: RecordDimName
979 ierr = nf90_open(trim(infile),nf90_write,
nc_fid)
980 IF(ierr /=nf90_noerr)
THEN 981 WRITE(*,*)
'ERROR OPENING ',trim(infile)
982 WRITE(*,*)trim(nf90_strerror(ierr))
988 ierr = nf90_inq_varid(
nc_fid,trim(varname),varid)
989 IF(ierr /=nf90_noerr)
THEN 990 WRITE(*,*)
'error getting variable id: ',trim(varname)
991 WRITE(*,*)trim(nf90_strerror(ierr))
995 ierr = nf90_inquire(
nc_fid, unlimiteddimid = recorddimid)
996 IF(ierr /=nf90_noerr)
THEN 997 WRITE(*,*)
'error inquire unlimited id for s: ' 998 WRITE(*,*)trim(nf90_strerror(ierr))
1001 ierr = nf90_inquire_dimension(
nc_fid, recorddimid, &
1002 name = recorddimname, len = nrecords)
1003 IF(ierr /=nf90_noerr)
THEN 1004 WRITE(*,*)
'error inquire length of unlimited id for s: ' 1005 WRITE(*,*)trim(nf90_strerror(ierr))
1008 print *,
"length of unlimited dimension are : ",nrecords
1015 ierr = nf90_put_var(
nc_fid,varid,temp,start=dims)
1016 IF(ierr /=nf90_noerr)
THEN 1017 WRITE(*,*)
'3 error getting variable: ',trim(varname)
1019 WRITE(*,*)trim(nf90_strerror(ierr))
1023 ierr = nf90_close(
nc_fid)
1039 SUBROUTINE ncd_write(INFILE,NPTS,TIME,LABEL,INDOMAIN,XP,YP,ZP,UP,VP,WP,EP,HP,INWATER,NT)
1044 INTEGER,
INTENT(IN) :: NPTS, NT
1045 INTEGER,
DIMENSION(NPTS),
INTENT(IN) :: LABEL,INDOMAIN,INWATER
1046 REAL(SP),
DIMENSION(NPTS),
INTENT(IN) :: XP,YP,ZP,UP,VP,WP,EP,HP
1047 REAL(SP),
INTENT(IN) :: TIME
1048 CHARACTER(LEN=100),
INTENT(IN) :: INFILE
1050 CHARACTER(LEN=100) :: TSTRING,NETCDF_CONVENTION
1052 INTEGER :: TIME_DID,TIME_VID,NLAG_DID,IND_VID,LAB_VID
1053 INTEGER :: X_VID,Y_VID,Z_VID,U_VID,V_VID,W_VID
1054 INTEGER :: DYNMTIME(1)
1055 INTEGER :: STAT1D(1),DYNM1D(2)
1056 REAL(SP),
ALLOCATABLE,
DIMENSION(:) :: TEMP
1062 ierr = nf90_create(trim(infile) ,nf90_clobber,
nc_fid)
1063 IF(ierr /=nf90_noerr)
THEN 1064 WRITE(*,*)
'error creating',trim(infile)
1065 WRITE(*,*)trim(nf90_strerror(ierr))
1070 netcdf_convention =
'CF-1.0' 1073 tstring =
"FVCOM Offline Lagrangian Particle Data" 1074 ierr = nf90_put_att(
nc_fid,nf90_global,
"title",tstring)
1075 ierr = nf90_put_att(
nc_fid,nf90_global,
"institution",
"SMAST")
1076 ierr = nf90_put_att(
nc_fid,nf90_global,
"source" ,
"OFFLINE_FVCOM")
1077 ierr = nf90_put_att(
nc_fid,nf90_global,
"modeler" ,
"PHIL MCCRACKEN")
1078 ierr = nf90_put_att(
nc_fid,nf90_global,
"Conventions",trim(netcdf_convention))
1081 ierr = nf90_def_dim(
nc_fid,
"nlag" ,npts,nlag_did)
1082 ierr = nf90_def_dim(
nc_fid,
"time" ,nf90_unlimited,time_did)
1084 dynmtime = (/time_did/)
1085 dynm1d = (/nlag_did,time_did/)
1086 stat1d = (/nlag_did/)
1090 ierr = nf90_def_var(
nc_fid,
"time",nf90_float,dynmtime,time_vid)
1091 ierr = nf90_put_att(
nc_fid,time_vid,
"long_name",
"time")
1092 ierr = nf90_put_att(
nc_fid,time_vid,
"units",
"seconds")
1095 ierr = nf90_def_var(
nc_fid,
"label",nf90_float,stat1d,lab_vid)
1096 ierr = nf90_put_att(
nc_fid,lab_vid,
"long_name",
"particle label")
1097 ierr = nf90_put_att(
nc_fid,lab_vid,
"units",
"")
1100 ierr = nf90_def_var(
nc_fid,
"indomain",nf90_float,dynm1d,ind_vid)
1101 ierr = nf90_put_att(
nc_fid,ind_vid,
"long_name",
"particle indomain (1)")
1102 ierr = nf90_put_att(
nc_fid,ind_vid,
"units",
"")
1104 ierr = nf90_def_var(
nc_fid,
"x",nf90_float,dynm1d,x_vid)
1105 ierr = nf90_put_att(
nc_fid,x_vid,
"long_name",
"particle x position")
1106 ierr = nf90_put_att(
nc_fid,x_vid,
"units",
"m")
1109 ierr = nf90_def_var(
nc_fid,
"y",nf90_float,dynm1d,y_vid)
1110 ierr = nf90_put_att(
nc_fid,y_vid,
"long_name",
"particle y position")
1111 ierr = nf90_put_att(
nc_fid,y_vid,
"units",
"m")
1114 ierr = nf90_def_var(
nc_fid,
"z",nf90_float,dynm1d,z_vid)
1115 ierr = nf90_put_att(
nc_fid,z_vid,
"long_name",
"particle z position")
1116 ierr = nf90_put_att(
nc_fid,z_vid,
"units",
"m")
1119 ierr = nf90_def_var(
nc_fid,
"u",nf90_float,dynm1d,u_vid)
1120 ierr = nf90_put_att(
nc_fid,u_vid,
"long_name",
"particle u velocity")
1121 ierr = nf90_put_att(
nc_fid,u_vid,
"units",
"cm/s")
1124 ierr = nf90_def_var(
nc_fid,
"v",nf90_float,dynm1d,v_vid)
1125 ierr = nf90_put_att(
nc_fid,v_vid,
"long_name",
"particle v velocity")
1126 ierr = nf90_put_att(
nc_fid,v_vid,
"units",
"cm/s")
1129 ierr = nf90_def_var(
nc_fid,
"omega",nf90_float,dynm1d,w_vid)
1130 ierr = nf90_put_att(
nc_fid,w_vid,
"long_name",
"particle w velocity")
1131 ierr = nf90_put_att(
nc_fid,w_vid,
"units",
"mm/s")
1135 ierr = nf90_def_var(
nc_fid,
"elev",nf90_float,dynm1d,w_vid)
1136 ierr = nf90_put_att(
nc_fid,w_vid,
"long_name",
"surface elevation above particle")
1137 ierr = nf90_put_att(
nc_fid,w_vid,
"units",
"m")
1139 ierr = nf90_def_var(
nc_fid,
"depth",nf90_float,dynm1d,w_vid)
1140 ierr = nf90_put_att(
nc_fid,w_vid,
"long_name",
"bottom depth at particle")
1141 ierr = nf90_put_att(
nc_fid,w_vid,
"units",
"m")
1144 ierr = nf90_def_var(
nc_fid,
"inwater",nf90_float,dynm1d,ind_vid)
1145 ierr = nf90_put_att(
nc_fid,ind_vid,
"long_name",
"particle inwater (1)")
1146 ierr = nf90_put_att(
nc_fid,ind_vid,
"units",
"")
1152 ierr = nf90_enddef(
nc_fid)
1155 ALLOCATE(temp(npts))
1156 temp(:) = float(label(:))
1161 ierr = nf90_close(
nc_fid)
1165 ierr = nf90_open(trim(infile),nf90_write,
nc_fid)
1166 IF(ierr /=nf90_noerr)
THEN 1167 WRITE(*,*)
'ERROR OPENING ',trim(infile)
1168 WRITE(*,*)trim(nf90_strerror(ierr))
1179 ALLOCATE(temp(npts))
1180 temp(:) = float(indomain(:))
1181 CALL putdvar(
nc_fid,len_trim(
'indomain'),
'indomain',npts,temp,nt)
1197 ALLOCATE(temp(npts))
1198 temp(:) = float(inwater(:))
1199 CALL putdvar(
nc_fid,len_trim(
'inwater'),
'inwater',npts,temp,nt)
1205 ierr = nf90_close(
nc_fid)
subroutine getdvar(FID, NLEN, VARNAME, I1, I2, TEMP, NT)
subroutine ncd_read_grid(INFILE)
real(sp), dimension(:), allocatable, target h
subroutine ncd_read_enkf(INFILE, UL, VL, T1L, S1L, ELL, HO)
subroutine putsvar(FID, NLEN, VARNAME, I1, TEMP)
subroutine getsvar(FID, NLEN, VARNAME, I1, I2, TEMP)
subroutine ncd_write_v(INFILE, ncell, nlayer, temp)
real(sp), dimension(:,:), allocatable, target dzz1
real(sp), dimension(:,:), allocatable, target a1u
subroutine ncd_write_t(INFILE, nnode, nlayer, temp)
real(sp), dimension(:,:), allocatable, target awx
real(sp), dimension(:,:), allocatable, target aw0
real(sp), dimension(:,:), allocatable, target awy
real(sp), dimension(:), allocatable, target vx
subroutine getsvar_d(FID, NLEN, VARNAME, I1, I2, TEMP)
subroutine ncd_write_s(INFILE, nnode, nlayer, temp)
real(sp), dimension(:), allocatable, target vy
subroutine ncd_write_u10(INFILE, ncell, nlayer, temp)
subroutine ncd_write_el(INFILE, nnode, nlayer, temp)
integer, dimension(:,:), allocatable, target nv
subroutine ncd_write_v10(INFILE, ncell, nlayer, temp)
subroutine ncd_read(INFILE, UL, VL, WWL, KHL, ELL, time, HO)
real(sp), dimension(:,:), allocatable, target zz1
real(sp), dimension(:,:), allocatable, target dzz
subroutine putdvar(FID, NLEN, VARNAME, I1, TEMP, NT)
real(sp), dimension(:,:), allocatable, target dz
subroutine ncd_find_read_time_enkf(INFILE, Time, HO)
integer function getdim(FID, SSIZE, DIMNAME)
real(sp), dimension(:,:), allocatable, target a2u
real(sp), dimension(:,:), allocatable, target z
real(sp), dimension(:,:), allocatable, target dz1
real(sp), dimension(:,:), allocatable, target z1
subroutine ncd_read_shape(INFILE)
subroutine ncd_write(INFILE, NPTS, TIME, LABEL, INDOMAIN, XP, YP, ZP, UP, VP, WP, EP, HP, INWATER, NT)
subroutine ncd_write_u(INFILE, ncell, nlayer, temp)
real(sp), dimension(:,:), allocatable, target zz