34 USE yomhook
,ONLY : lhook, dr_hook
35 USE parkind1
,ONLY : jprb
66 CHARACTER(LEN=18),
INTENT(IN) :: hfile
67 CHARACTER(LEN=5),
DIMENSION(3),
PARAMETER :: hvarname=(/
'drdt0',
'tau ',
'kappa'/)
74 REAL(KIND=JPRB) :: zhook_handle
76 IF (lhook) CALL dr_hook(
'SNOWCRO_FLANNER',0,zhook_handle)
84 ierror = nf_open(hfile,nf_nowrite,nid_file)
92 CALL mpi_bcast(nid_file,kind(nid_file)/4,mpi_integer,npio,ncomm,infompi)
101 IF (nrank==npio)
THEN
104 ierror=nf_close(nid_file)
108 IF (lhook) CALL dr_hook(
'SNOWCRO_FLANNER',1,zhook_handle)
119 INTEGER,
INTENT(IN) :: id_file
120 CHARACTER(LEN=5),
INTENT(IN) :: hsurf
121 REAL,
DIMENSION(:,:,:),
POINTER :: pvar
124 INTEGER,
DIMENSION(:),
ALLOCATABLE :: ivardimsid
128 IF (nrank==npio)
THEN
131 ierror = nf_inq_varid(id_file,trim(hsurf),nid_var)
135 ierror = nf_inq_varndims(id_file,nid_var,nvardims)
136 IF ( ierror/=nf_noerr ) CALL
handle_err_cdf(ierror,
"can't get variable dimensions number")
139 ALLOCATE(ivardimsid(nvardims))
140 ierror = nf_inq_vardimid(id_file,nid_var,ivardimsid)
141 IF ( ierror/=nf_noerr ) CALL
handle_err_cdf(ierror,
"can't get variable dimensions ids")
143 SELECT CASE (nvardims)
146 ierror = nf_inq_dimlen(id_file,ivardimsid(1),nlendim1)
147 IF ( ierror/=nf_noerr ) CALL
handle_err_cdf(ierror,
"can't get variable dimensions lengths")
148 ierror = nf_inq_dimlen(id_file,ivardimsid(2),nlendim2)
149 IF ( ierror/=nf_noerr ) CALL
handle_err_cdf(ierror,
"can't get variable dimensions lengths")
150 ierror = nf_inq_dimlen(id_file,ivardimsid(3),nlendim3)
151 IF ( ierror/=nf_noerr ) CALL
handle_err_cdf(ierror,
"can't get variable dimensions lengths")
154 CALL
abor1_sfx(
'SNOWCRO_FLANNER: incorrect number of dimensions for variable '//trim(hsurf))
163 CALL mpi_bcast(nlendim1,kind(nlendim1)/4,mpi_integer,npio,ncomm,infompi)
164 CALL mpi_bcast(nlendim2,kind(nlendim2)/4,mpi_integer,npio,ncomm,infompi)
165 CALL mpi_bcast(nlendim3,kind(nlendim3)/4,mpi_integer,npio,ncomm,infompi)
171 ALLOCATE(pvar(nlendim1,nlendim2,nlendim3))
174 IF (nrank==npio)
THEN
177 ierror = nf_get_var_double(id_file,nid_var,pvar)
185 CALL mpi_bcast(pvar,kind(pvar)*
SIZE(pvar)/4,mpi_real,npio,ncomm,infompi)
subroutine read_var_fz06(ID_FILE, HSURF, PVAR)
subroutine handle_err_cdf(status, line)
subroutine abor1_sfx(YTEXT)
subroutine read_fz06(HFILE)